From a1df9ad111fc4d306880cd3674d793a3610f12b1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?G=C3=A1bor=20Cs=C3=A1rdi?= Date: Fri, 25 Apr 2025 14:48:02 +0200 Subject: [PATCH 01/12] Upkeep 2025 --- DESCRIPTION | 1 + 1 file changed, 1 insertion(+) diff --git a/DESCRIPTION b/DESCRIPTION index 3119d253..511d959c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -59,3 +59,4 @@ Config/Needs/website: Config/testthat/edition: 3 Encoding: UTF-8 RoxygenNote: 7.3.2 +Config/usethis/last-upkeep: 2025-04-25 From 927d9d79d8392eb9b4e39b15b9eda2a37fb13101 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?G=C3=A1bor=20Cs=C3=A1rdi?= Date: Fri, 25 Apr 2025 15:43:53 +0200 Subject: [PATCH 02/12] `usethis::use_air()` --- .Rbuildignore | 2 + .vscode/extensions.json | 5 + .vscode/settings.json | 6 + R/aaa-utils.R | 6 +- R/aab-rstudio-detect.R | 63 ++-- R/ansi-hyperlink.R | 99 +++-- R/ansi-palette.R | 12 +- R/ansi-utils.R | 7 +- R/ansi.R | 103 +++--- R/ansiex.R | 174 +++++---- R/app.R | 16 +- R/assertions.R | 8 +- R/box-styles.R | 14 +- R/boxes.R | 41 ++- R/bullets.R | 9 +- R/cat.R | 11 +- R/cli-errors.R | 18 +- R/cli.R | 251 +++++++++---- R/cliapp-docs.R | 1 - R/cliapp.R | 143 +++++--- R/containers.R | 44 ++- R/debug.R | 20 +- R/defer.R | 345 +++++++++--------- R/diff.R | 21 +- R/docs.R | 1 - R/enc-utils.R | 1 - R/errors.R | 314 ++++++++++------ R/format-conditions.R | 55 ++- R/format.R | 1 - R/friendly-type.R | 308 ++++++++-------- R/glue.R | 50 ++- R/hash.R | 7 +- R/inline.R | 48 ++- R/internals.R | 40 +- R/keypress.R | 4 +- R/lorem.R | 8 +- R/num-ansi-colors.R | 47 ++- R/numbers.R | 49 ++- R/onload.R | 58 +-- R/pluralize.R | 20 +- R/prettycode.R | 95 +++-- R/print.R | 2 - R/progress-along.R | 82 +++-- R/progress-bar.R | 15 +- R/progress-c.R | 6 +- R/progress-client.R | 111 +++--- R/progress-server.R | 29 +- R/progress-ticking.R | 1 - R/progress-utils.R | 1 - R/progress-variables.R | 57 +-- R/rematch2.R | 15 +- R/rlang.R | 13 +- R/ruler.R | 1 - R/rules.R | 58 +-- R/server.R | 1 - R/simple-theme.R | 44 ++- R/sitrep.R | 9 +- R/sizes.R | 23 +- R/spark.R | 2 - R/spinner.R | 47 ++- R/status-bar.R | 115 +++--- R/symbol.R | 7 +- R/test.R | 92 ++--- R/themes.R | 99 +++-- R/time-ago.R | 42 +-- R/time.R | 10 +- R/timer.R | 1 - R/tree.R | 44 ++- R/tty.R | 32 +- R/unicode.R | 1 - R/utf8.R | 20 +- R/utils.R | 3 +- R/vt.R | 7 +- R/width.R | 9 +- R/zzz.R | 81 ++-- air.toml | 0 exec/news.R | 64 ++-- exec/outdated.R | 25 +- exec/search.R | 22 +- exec/up.R | 43 ++- inst/examples/apps/news.R | 64 ++-- inst/examples/apps/outdated.R | 25 +- inst/examples/apps/search.R | 22 +- inst/examples/apps/up.R | 42 ++- inst/shiny/along/app.R | 4 +- inst/shiny/format/app.R | 4 +- inst/shiny/nested/app.R | 4 +- inst/shiny/simple/app.R | 4 +- man/roxygen/meta.R | 1 - tests/testthat/helper.R | 79 ++-- tests/testthat/progresstest/R/test.R | 1 - tests/testthat/progresstestcpp/R/testcpp.R | 1 - tests/testthat/setup.R | 1 - tests/testthat/test-alerts.R | 1 - tests/testthat/test-ansi-combine.R | 1 - tests/testthat/test-ansi-html.R | 1 - tests/testthat/test-ansi-hyperlink.R | 61 +++- tests/testthat/test-ansi-make.R | 30 +- tests/testthat/test-ansi-palette.R | 1 - tests/testthat/test-ansi-utils.R | 1 - tests/testthat/test-ansi.R | 33 +- tests/testthat/test-ansiex-2.R | 47 ++- tests/testthat/test-ansiex.R | 97 +++-- tests/testthat/test-app.R | 1 - tests/testthat/test-assertions.R | 49 ++- tests/testthat/test-box-styles.R | 1 - tests/testthat/test-boxes.R | 11 +- tests/testthat/test-bullets.R | 5 +- tests/testthat/test-cat-helpers.R | 1 - tests/testthat/test-cat.R | 1 - tests/testthat/test-cliapp-output.R | 1 - tests/testthat/test-code.R | 1 - tests/testthat/test-collapsing.R | 42 ++- tests/testthat/test-console-width.R | 1 - tests/testthat/test-containers.R | 6 +- tests/testthat/test-css.R | 30 +- tests/testthat/test-custom-handler.R | 7 +- tests/testthat/test-deep-lists.R | 21 +- tests/testthat/test-defer.R | 1 - tests/testthat/test-diff.R | 13 +- tests/testthat/test-format-conditions.R | 88 +++-- tests/testthat/test-glue.R | 1 - tests/testthat/test-hash.R | 1 - tests/testthat/test-headers.R | 33 +- tests/testthat/test-inline-2.R | 17 +- tests/testthat/test-inline.R | 28 +- tests/testthat/test-keypress.R | 63 +++- tests/testthat/test-links.R | 322 +++++++++------- tests/testthat/test-lists.R | 1 - tests/testthat/test-meta.R | 1 - tests/testthat/test-non-breaking-space.R | 1 - tests/testthat/test-num-ansi-colors.R | 11 +- tests/testthat/test-package.R | 6 +- tests/testthat/test-pluralization.R | 4 +- tests/testthat/test-prettycode.R | 63 +++- tests/testthat/test-progress-along.R | 5 +- tests/testthat/test-progress-bar.R | 1 - tests/testthat/test-progress-c.R | 1 - tests/testthat/test-progress-client.R | 31 +- tests/testthat/test-progress-handler-logger.R | 1 - tests/testthat/test-progress-handler-say.R | 1 - tests/testthat/test-progress-handlers.R | 1 - tests/testthat/test-progress-message.R | 1 - tests/testthat/test-progress-ticking.R | 12 +- tests/testthat/test-progress-types.R | 19 +- tests/testthat/test-progress-utils.R | 1 - tests/testthat/test-progress-variables.R | 18 +- tests/testthat/test-rlang-errors.R | 101 +++-- tests/testthat/test-rules.R | 8 +- tests/testthat/test-sitrep.R | 1 - tests/testthat/test-spark.R | 1 - tests/testthat/test-spinners.R | 1 - tests/testthat/test-status-bar.R | 156 +++++--- tests/testthat/test-subprocess.R | 32 +- tests/testthat/test-substitution.R | 1 - tests/testthat/test-suppress.R | 1 - tests/testthat/test-text.R | 1 - tests/testthat/test-themes.R | 18 +- tests/testthat/test-timer.R | 1 - tests/testthat/test-tree.R | 118 ++++-- tests/testthat/test-type.R | 1 - tests/testthat/test-utf8.R | 1 - tests/testthat/test-utils.R | 10 +- tests/testthat/test-verbatim.R | 1 - tests/testthat/test-vt.R | 47 ++- tools/get-rstudio-themes.R | 88 +++-- tools/parse-iterm.R | 33 +- tools/spinners.R | 30 +- 168 files changed, 3481 insertions(+), 2378 deletions(-) create mode 100644 .vscode/extensions.json create mode 100644 .vscode/settings.json create mode 100644 air.toml diff --git a/.Rbuildignore b/.Rbuildignore index f15ab3f9..df53f515 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -35,3 +35,5 @@ ^man/chunks/FAQ_cache$ ^codecov\.yml$ ^tests/testthat/results.rds$ +^[\.]?air\.toml$ +^\.vscode$ diff --git a/.vscode/extensions.json b/.vscode/extensions.json new file mode 100644 index 00000000..344f76eb --- /dev/null +++ b/.vscode/extensions.json @@ -0,0 +1,5 @@ +{ + "recommendations": [ + "Posit.air-vscode" + ] +} diff --git a/.vscode/settings.json b/.vscode/settings.json new file mode 100644 index 00000000..f2d0b79d --- /dev/null +++ b/.vscode/settings.json @@ -0,0 +1,6 @@ +{ + "[r]": { + "editor.formatOnSave": true, + "editor.defaultFormatter": "Posit.air-vscode" + } +} diff --git a/R/aaa-utils.R b/R/aaa-utils.R index e41e7587..080e67f7 100644 --- a/R/aaa-utils.R +++ b/R/aaa-utils.R @@ -1,4 +1,3 @@ - `%||%` <- function(l, r) if (is.null(l)) r else l new_class <- function(class_name, ...) { @@ -32,13 +31,12 @@ is_latex_output <- function() { get("is_latex_output", asNamespace("knitr"))() } -is_windows <- function() { +is_windows <- function() { .Platform$OS.type == "windows" } apply_style <- function(text, style, bg = FALSE) { - if (identical(text, "")) - return(text) + if (identical(text, "")) return(text) if (is.function(style)) { style(text) diff --git a/R/aab-rstudio-detect.R b/R/aab-rstudio-detect.R index a295c846..6bbd0c5e 100644 --- a/R/aab-rstudio-detect.R +++ b/R/aab-rstudio-detect.R @@ -1,6 +1,4 @@ - rstudio <- local({ - standalone_env <- environment() parent.env(standalone_env) <- baseenv() @@ -18,7 +16,8 @@ rstudio <- local({ "RSTUDIO_CONSOLE_COLOR", "RSTUDIOAPI_IPC_REQUESTS_FILE", "XPC_SERVICE_NAME", - "ASCIICAST") + "ASCIICAST" + ) d <- list( pid = Sys.getpid(), @@ -60,8 +59,10 @@ rstudio <- local({ if (clear_cache) data <<- NULL if (!is.null(data)) return(get_caps(data)) - if ((rspid <- Sys.getenv("RSTUDIO_SESSION_PID")) != "" && - any(c("ps", "cli") %in% loadedNamespaces())) { + if ( + (rspid <- Sys.getenv("RSTUDIO_SESSION_PID")) != "" && + any(c("ps", "cli") %in% loadedNamespaces()) + ) { detect_new(rspid, clear_cache) } else { detect_old(clear_cache) @@ -94,31 +95,26 @@ rstudio <- local({ # direct subprocess new$type <- if (rspid == parentpid) { - if (pane == "job") { "rstudio_job" - } else if (pane == "build") { "rstudio_build_pane" - } else if (pane == "render") { "rstudio_render_pane" - - } else if (pane == "terminal" && new$tty && - new$envs["ASCIICAST"] != "true") { + } else if ( + pane == "terminal" && new$tty && new$envs["ASCIICAST"] != "true" + ) { # not possible, because there is a shell in between, just in case "rstudio_terminal" - } else { # don't know what kind of direct subprocess "rstudio_subprocess" } - - } else if (pane == "terminal" && new$tty && - new$envs[["ASCIICAST"]] != "true") { + } else if ( + pane == "terminal" && new$tty && new$envs[["ASCIICAST"]] != "true" + ) { # not a direct subproces, so check other criteria as well "rstudio_terminal" - } else { # don't know what kind of subprocess "rstudio_subprocess" @@ -128,7 +124,6 @@ rstudio <- local({ } detect_old <- function(clear_cache = FALSE) { - # Cache unless told otherwise cache <- TRUE new <- get_data() @@ -136,20 +131,16 @@ rstudio <- local({ new$type <- if (new$envs[["RSTUDIO"]] != "1") { # 1. Not RStudio at all "not_rstudio" - } else if (new$gui == "RStudio" && new$api) { # 2. RStudio console, properly initialized "rstudio_console" - - } else if (! new$api && basename(new$args[1]) == "RStudio") { + } else if (!new$api && basename(new$args[1]) == "RStudio") { # 3. RStudio console, initializing cache <- FALSE "rstudio_console_starting" - } else if (new$gui == "Rgui") { # Still not RStudio, but Rgui that was started from RStudio "not_rstudio" - } else if (new$tty && new$envs[["ASCIICAST"]] != "true") { # 4. R in the RStudio terminal # This could also be a subprocess of the console or build pane @@ -157,29 +148,31 @@ rstudio <- local({ # out, without inspecting some process data with ps::ps_*(). # At least we rule out asciicast "rstudio_terminal" - - } else if (! new$tty && - new$envs[["RSTUDIO_TERM"]] == "" && - new$envs[["R_BROWSER"]] == "false" && - new$envs[["R_PDFVIEWER"]] == "false" && - is_build_pane_command(new$args)) { + } else if ( + !new$tty && + new$envs[["RSTUDIO_TERM"]] == "" && + new$envs[["R_BROWSER"]] == "false" && + new$envs[["R_PDFVIEWER"]] == "false" && + is_build_pane_command(new$args) + ) { # 5. R in the RStudio build pane # https://github.com/rstudio/rstudio/blob/main/src/cpp/session/ # modules/build/SessionBuild.cpp#L231-L240 "rstudio_build_pane" - - } else if (new$envs[["RSTUDIOAPI_IPC_REQUESTS_FILE"]] != "" && - grepl("rstudio", new$envs[["XPC_SERVICE_NAME"]], fixed = TRUE)) { + } else if ( + new$envs[["RSTUDIOAPI_IPC_REQUESTS_FILE"]] != "" && + grepl("rstudio", new$envs[["XPC_SERVICE_NAME"]], fixed = TRUE) + ) { # RStudio job, XPC_SERVICE_NAME=0 in the subprocess of a job # process. Hopefully this is reliable. "rstudio_job" - - } else if (new$envs[["RSTUDIOAPI_IPC_REQUESTS_FILE"]] != "" && - any(grepl("SourceWithProgress.R", new$args))) { + } else if ( + new$envs[["RSTUDIOAPI_IPC_REQUESTS_FILE"]] != "" && + any(grepl("SourceWithProgress.R", new$args)) + ) { # Or we can check SourceWithProgress.R in the command line, see # https://github.com/r-lib/cli/issues/367 "rstudio_job" - } else { # Otherwise it is a subprocess of the console, terminal or # build pane, and it is hard to say which, so we do not try. diff --git a/R/ansi-hyperlink.R b/R/ansi-hyperlink.R index a059f8c4..c138c50e 100644 --- a/R/ansi-hyperlink.R +++ b/R/ansi-hyperlink.R @@ -1,4 +1,3 @@ - #' Auto-linking existing styles #' #' They keep formatting. It is not possible to use a different link text @@ -37,22 +36,36 @@ #' @noRd NULL -make_link <- function(txt, type = c("email", "file", "fun", "help", "href", - "run", "topic", "url", "vignette")) { +make_link <- function( + txt, + type = c( + "email", + "file", + "fun", + "help", + "href", + "run", + "topic", + "url", + "vignette" + ) +) { type <- match.arg(type) switch( type, - email = make_link_email(txt), - file = make_link_file(txt), - fun = make_link_fun(txt), - help = make_link_help(txt), - href = make_link_href(txt), - run = make_link_run(txt), - topic = make_link_topic(txt), - url = make_link_url(txt), + email = make_link_email(txt), + file = make_link_file(txt), + fun = make_link_fun(txt), + help = make_link_help(txt), + href = make_link_href(txt), + run = make_link_run(txt), + topic = make_link_topic(txt), + url = make_link_url(txt), vignette = make_link_vignette(txt), - throw(cli_error("Unknown hyperlink type: {.code {type}}, internal cli error")) # nocov + throw(cli_error( + "Unknown hyperlink type: {.code {type}}, internal cli error" + )) # nocov ) } @@ -104,7 +117,8 @@ construct_file_link <- function(params) { params$path <- path.expand(params$path) looks_absolute <- function(path) { - grepl("^/", params$path) || (is_windows() && grepl("^[a-zA-Z]:", params$path)) + grepl("^/", params$path) || + (is_windows() && grepl("^[a-zA-Z]:", params$path)) } if (!looks_absolute(params$path)) { params$path <- file.path(getwd(), params$path) @@ -129,11 +143,16 @@ interpolate_parts <- function(fmt, params) { # interpolate a part, if possible # if no placeholder for part, this is a no-op # if placeholder exists, but no value to fill, remove placeholder (and everything after it!) -interpolate_part <- function(fmt, part = c("column", "line", "path"), value = NULL) { +interpolate_part <- function( + fmt, + part = c("column", "line", "path"), + value = NULL +) { part <- match.arg(part) re <- glue( "^(?.*)(?\\{<<>>\\})(?.*?)$", - .open = "<<<", .close = ">>>" + .open = "<<<", + .close = ">>>" ) m <- re_match(fmt, re) @@ -292,8 +311,15 @@ make_link_vignette <- function(txt) { sprt <- ansi_hyperlink_types()$vignette if (!sprt) { - vignette2 <- vcapply(vignette, function(x) format_inline("{.code vignette({x})}")) - return(ifelse(text == vignette, vignette2, paste0(text, " (", vignette2, ")"))) + vignette2 <- vcapply( + vignette, + function(x) format_inline("{.code vignette({x})}") + ) + return(ifelse( + text == vignette, + vignette2, + paste0(text, " (", vignette2, ")") + )) } fmt <- get_hyperlink_format("vignette") @@ -328,7 +354,9 @@ make_link_vignette <- function(txt) { style_hyperlink <- function(text, url, params = NULL) { params <- if (length(params)) { paste( - names(params), "=", params, + names(params), + "=", + params, collapse = ":" ) } @@ -355,37 +383,51 @@ style_hyperlink <- function(text, url, params = NULL) { #' ansi_has_hyperlink_support() ansi_has_hyperlink_support <- function() { - ## Hyperlinks forced? enabled <- getOption("cli.hyperlink", getOption("crayon.hyperlink")) - if (!is.null(enabled)) { return(isTRUE(enabled)) } + if (!is.null(enabled)) { + return(isTRUE(enabled)) + } ## forced by environment variable enabled <- Sys.getenv("R_CLI_HYPERLINKS", "") - if (isTRUE(as.logical(enabled))){ return(TRUE) } + if (isTRUE(as.logical(enabled))) { + return(TRUE) + } ## If ANSI support is off, then this is off as well if (num_ansi_colors() == 1) return(FALSE) ## Are we in RStudio? rstudio <- rstudio_detect() - if (rstudio$type != "not_rstudio") { return(rstudio$hyperlink) } + if (rstudio$type != "not_rstudio") { + return(rstudio$hyperlink) + } ## Are we in a terminal? No? - if (!isatty(stdout())) { return(FALSE) } + if (!isatty(stdout())) { + return(FALSE) + } ## Are we in a windows terminal? - if (is_windows() && Sys.getenv("WT_SESSION") != "") { return(TRUE) } + if (is_windows() && Sys.getenv("WT_SESSION") != "") { + return(TRUE) + } ## Better to avoid it in CIs - if (nzchar(Sys.getenv("CI")) || - nzchar(Sys.getenv("TEAMCITY_VERSION"))) { return(FALSE) } + if ( + nzchar(Sys.getenv("CI")) || + nzchar(Sys.getenv("TEAMCITY_VERSION")) + ) { + return(FALSE) + } ## iTerm if (nzchar(TERM_PROGRAM <- Sys.getenv("TERM_PROGRAM"))) { version <- package_version( Sys.getenv("TERM_PROGRAM_VERSION"), - strict = FALSE) + strict = FALSE + ) if (TERM_PROGRAM == "iTerm.app") { if (!is.na(version) && version >= "3.1") return(TRUE) @@ -420,7 +462,6 @@ ansi_has_hyperlink_support <- function() { #' @export ansi_hyperlink_types <- function() { - get_config <- function(x, default = NULL) { opt <- getOption(paste0("cli.", tolower(x))) if (!is.null(opt)) return(isTRUE(opt)) @@ -446,7 +487,6 @@ ansi_hyperlink_types <- function() { help = FALSE, vignette = FALSE ) - } else if (isTRUE(rs$hyperlink)) { list( href = TRUE, @@ -454,7 +494,6 @@ ansi_hyperlink_types <- function() { help = structure(hlp, type = "rstudio"), vignette = structure(vgn, type = "rstudio") ) - } else { list( href = TRUE, diff --git a/R/ansi-palette.R b/R/ansi-palette.R index 04209eb3..0511e27c 100644 --- a/R/ansi-palette.R +++ b/R/ansi-palette.R @@ -1,4 +1,3 @@ - get_palette_color <- function(style, colors = num_ansi_colors()) { opt <- getOption("cli.palette") if (is.null(opt) || colors < 256) return(style) @@ -9,7 +8,7 @@ palette_cache <- new.env(parent = emptyenv()) cache_palette_color <- function(pal, idx, colors = num_ansi_colors()) { if (is_string(pal)) { - if (! pal %in% rownames(ansi_palettes)) { + if (!pal %in% rownames(ansi_palettes)) { opt <- options(cli.palette = NULL) defer(options(opt)) throw(cli_error( @@ -54,7 +53,7 @@ cache_palette_color <- function(pal, idx, colors = num_ansi_colors()) { #' @export #' @rdname ansi_palettes -truecolor <- as.integer(256 ^ 3) +truecolor <- as.integer(256^3) #' ANSI colors palettes #' @@ -174,8 +173,11 @@ attr(ansi_palettes, "info") <- #' @export #' @rdname ansi_palettes -ansi_palette_show <- function(palette = NULL, colors = num_ansi_colors(), - rows = 4) { +ansi_palette_show <- function( + palette = NULL, + colors = num_ansi_colors(), + rows = 4 +) { opts <- options( cli.palette = palette %||% getOption("cli.palette"), cli.num_colors = colors diff --git a/R/ansi-utils.R b/R/ansi-utils.R index 113f237f..95bc45e0 100644 --- a/R/ansi-utils.R +++ b/R/ansi-utils.R @@ -1,4 +1,3 @@ - re_table <- function(...) { lapply(gregexpr(...), function(x) { res <- cbind( @@ -6,7 +5,7 @@ re_table <- function(...) { end = x + attr(x, "match.length") - 1, length = attr(x, "match.length") ) - res <- res[res[, "start"] != -1, , drop=FALSE] + res <- res[res[, "start"] != -1, , drop = FALSE] }) } @@ -14,13 +13,13 @@ re_table <- function(...) { non_matching <- function(table, str, empty = FALSE) { mapply(table, str, SIMPLIFY = FALSE, FUN = function(t, s) { - if (! nrow(t)) { + if (!nrow(t)) { cbind(start = 1, end = base::nchar(s), length = base::nchar(s)) } else { start <- c(1, t[, "end"] + 1) end <- c(t[, "start"] - 1, base::nchar(s)) res <- cbind(start = start, end = end, length = end - start + 1) - if (!empty) res[ res[, "length"] != 0, , drop = FALSE ] else res + if (!empty) res[res[, "length"] != 0, , drop = FALSE] else res } }) } diff --git a/R/ansi.R b/R/ansi.R index 1c828df5..407f23fc 100644 --- a/R/ansi.R +++ b/R/ansi.R @@ -1,4 +1,3 @@ - # this is install time # nocov start @@ -6,14 +5,16 @@ palette_idx <- function(id) { ifelse( id < 38, id - (30 - 1), - ifelse( - id < 48, - -(id - (40 - 1)), - ifelse( - id < 98, - id - (90 - 9), - -(id - (100 - 9)) - ))) + ifelse( + id < 48, + -(id - (40 - 1)), + ifelse( + id < 98, + id - (90 - 9), + -(id - (100 - 9)) + ) + ) + ) } palette_color <- function(x) { @@ -68,17 +69,17 @@ ansi_builtin_styles <- list( bg_br_white = palette_color(list(107, 49)), # similar to reset, but only for a single property - no_bold = list(c(0, 23, 24, 27, 28, 29, 39, 49), 22), - no_blurred = list(c(0, 23, 24, 27, 28, 29, 39, 49), 22), - no_italic = list(c(0, 22, 24, 27, 28, 29, 39, 49), 23), - no_underline = list(c(0, 22, 23, 27, 28, 29, 39, 49), 24), - no_inverse = list(c(0, 22, 23, 24, 28, 29, 39, 49), 27), - no_hidden = list(c(0, 22, 23, 24, 27, 29, 39, 49), 28), - no_strikethrough = list(c(0, 22, 23, 24, 27, 28, 39, 49), 29), - none = list(c(0, 22, 23, 24, 27, 28, 29, 49), 39), - no_color = list(c(0, 22, 23, 24, 27, 28, 29, 49), 39), - bg_none = list(c(0, 22, 23, 24, 27, 28, 29, 39 ), 49), - no_bg_color = list(c(0, 22, 23, 24, 27, 28, 29, 39 ), 49) + no_bold = list(c(0, 23, 24, 27, 28, 29, 39, 49), 22), + no_blurred = list(c(0, 23, 24, 27, 28, 29, 39, 49), 22), + no_italic = list(c(0, 22, 24, 27, 28, 29, 39, 49), 23), + no_underline = list(c(0, 22, 23, 27, 28, 29, 39, 49), 24), + no_inverse = list(c(0, 22, 23, 24, 28, 29, 39, 49), 27), + no_hidden = list(c(0, 22, 23, 24, 27, 29, 39, 49), 28), + no_strikethrough = list(c(0, 22, 23, 24, 27, 28, 39, 49), 29), + none = list(c(0, 22, 23, 24, 27, 28, 29, 49), 39), + no_color = list(c(0, 22, 23, 24, 27, 28, 29, 49), 39), + bg_none = list(c(0, 22, 23, 24, 27, 28, 29, 39), 49), + no_bg_color = list(c(0, 22, 23, 24, 27, 28, 29, 39), 49) ) # nocov end @@ -126,23 +127,26 @@ create_ansi_style_tag <- function(name, open, close, palette = NULL) { } create_ansi_style_fun <- function(styles) { - fun <- eval(substitute(function(...) { - txt <- paste0(...) - nc <- num_ansi_colors() - if (nc > 1 && length(txt) > 0) { - mystyles <- .styles - for (st in rev(mystyles)) { - if (!is.null(st$palette)) st <- get_palette_color(st, nc) - txt <- paste0( - st$open, - gsub(st$close, st$open, txt, fixed = TRUE), - st$close - ) + fun <- eval(substitute( + function(...) { + txt <- paste0(...) + nc <- num_ansi_colors() + if (nc > 1 && length(txt) > 0) { + mystyles <- .styles + for (st in rev(mystyles)) { + if (!is.null(st$palette)) st <- get_palette_color(st, nc) + txt <- paste0( + st$open, + gsub(st$close, st$open, txt, fixed = TRUE), + st$close + ) + } } - } - class(txt) <- c("cli_ansi_string", "ansi_string", "character") - txt - }, list(.styles = styles))) + class(txt) <- c("cli_ansi_string", "ansi_string", "character") + txt + }, + list(.styles = styles) + )) class(fun) <- c("cli_ansi_style", "ansi_style") attr(fun, "_styles") <- styles @@ -220,9 +224,12 @@ print.cli_ansi_style <- function(x, ...) { #' orange("foobar") #' cat(orange("foobar")) -make_ansi_style <- function(..., bg = FALSE, grey = FALSE, - colors = num_ansi_colors()) { - +make_ansi_style <- function( + ..., + bg = FALSE, + grey = FALSE, + colors = num_ansi_colors() +) { style <- list(...)[[1]] if (inherits(style, "cli_ansi_style")) return(style) if (inherits(style, "crayon")) { @@ -234,13 +241,15 @@ make_ansi_style <- function(..., bg = FALSE, grey = FALSE, orig_style_name <- style_name <- names(args)[1] stop_if_not( - is.character(style) && length(style) == 1 || - is_rgb_matrix(style) && ncol(style) == 1, + is.character(style) && + length(style) == 1 || + is_rgb_matrix(style) && ncol(style) == 1, message = c( "{.arg style} must be an ANSI style", "i" = paste( "an ANSI style is a character scalar (cli style name, RGB or R color", - "name), or a [3x1] or [4x1] numeric RGB matrix"), + "name), or a [3x1] or [4x1] numeric RGB matrix" + ), "i" = "{.arg style} is {.type {style}}" ) ) @@ -255,11 +264,9 @@ make_ansi_style <- function(..., bg = FALSE, grey = FALSE, } if (is.null(style_name)) style_name <- style ansi_builtin_styles[[style]] - } else if (is_r_color(style)) { if (is.null(style_name)) style_name <- style ansi_style_from_r_color(style, bg, colors, grey) - } else if (is_rgb_matrix(style)) { if (is.null(style_name)) { style_name <- paste0( @@ -268,7 +275,6 @@ make_ansi_style <- function(..., bg = FALSE, grey = FALSE, ) } ansi_style_from_rgb(style, bg, colors, grey) - } else { throw(cli_error( "Unknown style specification: {.val style}, it must be one of", @@ -301,14 +307,16 @@ ansi_style_from_r_color <- function(color, bg, num_colors, grey) { ansi_style_8_from_rgb <- function(rgb, bg) { ansi_cols <- if (bg) ansi_bg_rgb else ansi_fg_rgb - dist <- colSums((ansi_cols - as.vector(rgb)) ^ 2 ) + dist <- colSums((ansi_cols - as.vector(rgb))^2) builtin_name <- names(which.min(dist))[1] btn <- ansi_builtin_styles[[builtin_name]] list(open = ansi_style_str(btn[[1]]), close = ansi_style_str(btn[[2]])) } ansi_style_from_rgb <- function(rgb, bg, num_colors, grey) { - if (num_colors < 256) { return(ansi_style_8_from_rgb(rgb, bg)) } + if (num_colors < 256) { + return(ansi_style_8_from_rgb(rgb, bg)) + } if (num_colors < truecolor || grey) return(ansi256(rgb, bg, grey)) return(ansitrue(rgb, bg)) } @@ -343,7 +351,6 @@ ansi256 <- function(rgb, bg = FALSE, grey = FALSE) { open = codes[gray_index][ansi_scale(rgb[1], to = c(0, 23)) + 1], close = codes[reset_index] ) - } else { ## Not gray list( diff --git a/R/ansiex.R b/R/ansiex.R index 1c6dae20..422a5d8a 100644 --- a/R/ansiex.R +++ b/R/ansiex.R @@ -123,9 +123,10 @@ ansi_strip <- function(string, sgr = TRUE, csi = TRUE, link = TRUE) { #' ansi_nchar(str) #' nchar(ansi_strip(str)) -ansi_nchar <- function(x, - type = c("chars", "bytes", "width", "graphemes", - "codepoints")) { +ansi_nchar <- function( + x, + type = c("chars", "bytes", "width", "graphemes", "codepoints") +) { type <- match.arg(type) if (type == "chars") type <- "graphemes" type <- match(type, c("graphemes", "bytes", "width", "codepoints")) @@ -195,12 +196,16 @@ ansi_substr <- function(x, start, stop) { if (nastart || nastop) { throw(cli_error( "{.arg start} and {.arg stop} must not have {.code NA} values", - "i" = if (nastart) paste( - "{.arg start} has {sum(is.na(start))}", - "{.code NA} value{?s}, after coercion to integer"), - "i" = if (nastop) paste( - "{.arg stop} has {sum(is.na(stop))} {.code NA} value{?s},", - "after coercion to integer") + "i" = if (nastart) + paste( + "{.arg start} has {sum(is.na(start))}", + "{.code NA} value{?s}, after coercion to integer" + ), + "i" = if (nastop) + paste( + "{.arg stop} has {sum(is.na(stop))} {.code NA} value{?s},", + "after coercion to integer" + ) )) } x <- enc2utf8(x) @@ -303,7 +308,9 @@ ansi_substring <- function(text, first, last = 1000000L) { ansi_strsplit <- function(x, split, ...) { split <- try(as.character(split), silent = TRUE) - if (inherits(split, "try-error") || !is.character(split) || length(split) > 1L) { + if ( + inherits(split, "try-error") || !is.character(split) || length(split) > 1L + ) { throw(cli_error( "{.arg split} must be character of length <= 1, or must coerce to that", i = "{.arg split} is (or was coerced to) {.type {split}}" @@ -311,24 +318,25 @@ ansi_strsplit <- function(x, split, ...) { } if (!is.character(x)) x <- as.character(x) x <- enc2utf8(x) - if(!length(split)) split <- "" + if (!length(split)) split <- "" plain <- ansi_strip(x) splits <- re_table(split, plain, ...) chunks <- non_matching(splits, plain, empty = TRUE) # silently recycle `split`; doesn't matter currently since we don't support # split longer than 1, but might in future - split.r <- rep(split, length.out=length(x)) + split.r <- rep(split, length.out = length(x)) # Drop empty chunks to align with `substr` behavior chunks <- lapply( seq_along(chunks), function(i) { y <- chunks[[i]] # empty split means drop empty first match - if(nrow(y) && !nzchar(split.r[[i]]) && !utils::head(y, 1L)[, "length"]) { - y <- y[-1L, , drop=FALSE] + if (nrow(y) && !nzchar(split.r[[i]]) && !utils::head(y, 1L)[, "length"]) { + y <- y[-1L, , drop = FALSE] } # drop empty last matches - if(nrow(y) && !utils::tail(y, 1L)[, "length"]) y[-nrow(y), , drop=FALSE] else y + if (nrow(y) && !utils::tail(y, 1L)[, "length"]) + y[-nrow(y), , drop = FALSE] else y } ) zero.chunks <- !vapply(chunks, nrow, integer(1L)) @@ -337,7 +345,9 @@ ansi_strsplit <- function(x, split, ...) { res <- vector("list", length(chunks)) res[zero.chunks] <- list(character(0L)) res[!zero.chunks] <- mapply( - chunks[!zero.chunks], x[!zero.chunks], SIMPLIFY = FALSE, + chunks[!zero.chunks], + x[!zero.chunks], + SIMPLIFY = FALSE, FUN = function(tab, xx) ansi_substring(xx, tab[, "start"], tab[, "end"]) ) lapply(res, ansi_string) @@ -385,10 +395,12 @@ ansi_strsplit <- function(x, split, ...) { # TODO: show wide Unicode charadcters, once they work in asciicast -ansi_align <- function(text, width = console_width(), - align = c("left", "center", "right"), - type = "width") { - +ansi_align <- function( + text, + width = console_width(), + align = c("left", "center", "right"), + type = "width" +) { align <- match.arg(align) text <- enc2utf8(text) nc <- ansi_nchar(text, type = type) @@ -397,12 +409,12 @@ ansi_align <- function(text, width = console_width(), res <- if (align == "left") { paste0(text, make_space(width - nc)) - } else if (align == "center") { - paste0(make_space(ceiling((width - nc) / 2)), - text, - make_space(floor((width - nc) / 2))) - + paste0( + make_space(ceiling((width - nc) / 2)), + text, + make_space(floor((width - nc) / 2)) + ) } else { paste0(make_space(width - nc), text) } @@ -417,7 +429,7 @@ make_space <- function(num, filling = " ") { res } -strrep <- function (x, times) { +strrep <- function(x, times) { x = as.character(x) if (length(x) == 0L) return(x) @@ -431,7 +443,8 @@ strrep <- function (x, times) { paste0(rep(x, times), collapse = "") } }, - x, times, + x, + times, USE.NAMES = FALSE ) } @@ -454,7 +467,6 @@ strrep <- function (x, times) { #' ansi_trimws(col_red(" I am red ")) ansi_trimws <- function(x, which = c("both", "left", "right")) { - if (!is.character(x)) x <- as.character(x) which <- match.arg(which) x <- enc2utf8(x) @@ -511,17 +523,27 @@ ansi_trimws <- function(x, which = c("both", "left", "right")) { #' wrp <- ansi_strwrap(text, width = 40) #' cat(wrp, sep = "\n") -ansi_strwrap <- function(x, width = console_width(), indent = 0, - exdent = 0, simplify = TRUE) { - +ansi_strwrap <- function( + x, + width = console_width(), + indent = 0, + exdent = 0, + simplify = TRUE +) { if (!is.character(x)) x <- as.character(x) x <- enc2utf8(x) if (length(x) == 0) { return(ansi_string(x)) } if (length(x) > 1) { - wrp <- lapply(x, ansi_strwrap, width = width, indent = indent, - exdent = exdent, simplify = FALSE) + wrp <- lapply( + x, + ansi_strwrap, + width = width, + indent = indent, + exdent = exdent, + simplify = FALSE + ) if (simplify) wrp <- ansi_string(unlist(wrp)) return(wrp) } @@ -563,7 +585,6 @@ ansi_strwrap <- function(x, width = console_width(), indent = 0, } else { x } - } # First we need to remove the multiple spaces, to make it easier to @@ -660,9 +681,11 @@ ansi_strwrap <- function(x, width = console_width(), indent = 0, #' text <- cli::col_red(cli:::lorem_ipsum()) #' ansi_strtrim(c(text, "foobar"), 40) -ansi_strtrim <- function(x, width = console_width(), - ellipsis = symbol$ellipsis) { - +ansi_strtrim <- function( + x, + width = console_width(), + ellipsis = symbol$ellipsis +) { if (width < 0) { throw(cli_error( "{.arg width} must be non-negative in {.fun cli::ansi_strtrim}." @@ -752,11 +775,16 @@ ansi_strtrim <- function(x, width = console_width(), #' @family ANSI string operations #' @export -ansi_columns <- function(text, width = console_width(), sep = " ", - fill = c("rows", "cols"), max_cols = 4, - align = c("left", "center", "right"), - type = "width", ellipsis = symbol$ellipsis) { - +ansi_columns <- function( + text, + width = console_width(), + sep = " ", + fill = c("rows", "cols"), + max_cols = 4, + align = c("left", "center", "right"), + type = "width", + ellipsis = symbol$ellipsis +) { fill <- match.arg(fill) align <- match.arg(align) @@ -777,7 +805,7 @@ ansi_columns <- function(text, width = console_width(), sep = " ", text <- c(text, rep("", extra)) tm <- matrix(text, byrow = fill == "rows", ncol = cols) - colwdh <- diff(c(0, round((width / cols) * (1:cols)))) + colwdh <- diff(c(0, round((width / cols) * (1:cols)))) for (c in seq_len(ncol(tm))) { tm[, c] <- ansi_align( paste0(tm[, c], if (cols > 1) sep), @@ -834,9 +862,9 @@ ansi_chartr <- function(old, new, x) { ansi_convert <- function(x, converter, ...) { x <- enc2utf8(x) ansi <- re_table(ansi_regex(), x) - text <- non_matching(ansi, x, empty=TRUE) + text <- non_matching(ansi, x, empty = TRUE) out <- mapply(x, text, USE.NAMES = FALSE, FUN = function(x1, t1) { - t1 <- t1[t1[,1] <= t1[,2], , drop = FALSE] + t1 <- t1[t1[, 1] <= t1[, 2], , drop = FALSE] for (i in seq_len(nrow(t1))) { substring(x1, t1[i, 1], t1[i, 2]) <- converter(x = substring(x1, t1[i, 1], t1[i, 2]), ...) @@ -899,8 +927,8 @@ ansi_html <- function(x, escape_reserved = TRUE, csi = c("drop", "keep")) { x <- enc2utf8(x) if (escape_reserved) { x <- gsub_("&", "&", x, fixed = TRUE, useBytes = TRUE) - x <- gsub_("<", "<", x, fixed = TRUE, useBytes = TRUE) - x <- gsub_(">", ">", x, fixed = TRUE, useBytes = TRUE) + x <- gsub_("<", "<", x, fixed = TRUE, useBytes = TRUE) + x <- gsub_(">", ">", x, fixed = TRUE, useBytes = TRUE) } .Call(clic_ansi_html, x, csi == "keep") } @@ -935,19 +963,20 @@ ansi_html_style <- function(colors = TRUE, palette = NULL) { } stopifnot( - isTRUE(colors) || identical(colors, FALSE) || - (is_count(colors) && colors %in% c(8,256)), + isTRUE(colors) || + identical(colors, FALSE) || + (is_count(colors) && colors %in% c(8, 256)), is_string(palette) || is.list(palette) && length(palette) == 16 ) ret <- list( - ".ansi-bold" = "{ font-weight: bold; }", + ".ansi-bold" = "{ font-weight: bold; }", # .ansi-faint ??? - ".ansi-italic" = "{ font-style: italic; }", - ".ansi-underline" = "{ text-decoration: underline; }", - ".ansi-blink" = "{ text-decoration: blink; }", + ".ansi-italic" = "{ font-style: italic; }", + ".ansi-underline" = "{ text-decoration: underline; }", + ".ansi-blink" = "{ text-decoration: blink; }", # .ansi-inverse ??? - ".ansi-hide" = "{ visibility: hidden; }", + ".ansi-hide" = "{ visibility: hidden; }", ".ansi-crossedout" = "{ text-decoration: line-through; }", ".ansi-link:hover" = "{ text-decoration: underline; }" ) @@ -994,7 +1023,10 @@ ansi_html_style <- function(colors = TRUE, palette = NULL) { } # This avoids duplication, but messes up the source ref of the function... -formals(ansi_html_style)$palette <- c("vscode", setdiff(rownames(ansi_palettes), "vscode")) +formals(ansi_html_style)$palette <- c( + "vscode", + setdiff(rownames(ansi_palettes), "vscode") +) attr(body(ansi_html_style), "srcref") <- NULL attr(body(ansi_html_style), "wholeSrcref") <- NULL attr(body(ansi_html_style), "srcfile") <- NULL @@ -1040,18 +1072,36 @@ print.cli_ansi_html_style <- function(x, ...) { #' ansi_grepl(red_needle, haystack) #' ansi_grepl(red_needle, green_haystack) -ansi_grep <- function(pattern, x, ignore.case = FALSE, perl = FALSE, - value = FALSE, ...) { - +ansi_grep <- function( + pattern, + x, + ignore.case = FALSE, + perl = FALSE, + value = FALSE, + ... +) { # if value = FALSE, then we want to return the original values as # ansi strings, so we need to special case that if (value) { - idx <- ansi_grep(pattern, x, ignore.case = ignore.case, perl = perl, - value = FALSE, ...) + idx <- ansi_grep( + pattern, + x, + ignore.case = ignore.case, + perl = perl, + value = FALSE, + ... + ) ansi_string(x[idx]) } else { - ansi_grep_internal(grep, pattern, x, ignore.case = ignore.case, - perl = perl, value = value, ...) + ansi_grep_internal( + grep, + pattern, + x, + ignore.case = ignore.case, + perl = perl, + value = value, + ... + ) } } diff --git a/R/app.R b/R/app.R index a25dc494..7f0bc478 100644 --- a/R/app.R +++ b/R/app.R @@ -1,4 +1,3 @@ - cliappenv <- new.env() cliappenv$stack <- list() cliappenv$pid <- Sys.getpid() @@ -26,11 +25,13 @@ cliappenv$pid <- Sys.getpid() #' #' @export -start_app <- function(theme = getOption("cli.theme"), - output = c("auto", "message", "stdout", "stderr"), - .auto_close = TRUE, .envir = parent.frame()) { - - if (! inherits(output, "connection")) output <- match.arg(output) +start_app <- function( + theme = getOption("cli.theme"), + output = c("auto", "message", "stdout", "stderr"), + .auto_close = TRUE, + .envir = parent.frame() +) { + if (!inherits(output, "connection")) output <- match.arg(output) app <- cliapp( theme = theme, @@ -52,7 +53,6 @@ start_app <- function(theme = getOption("cli.theme"), stop_app <- function(app = NULL) { if (is.null(app)) { cliappenv$stack <- utils::head(cliappenv$stack, -1) - } else { if (!inherits(app, "cliapp")) { throw(cli_error( @@ -62,7 +62,7 @@ stop_app <- function(app = NULL) { } ndl <- format.default(app) nms <- vapply(cliappenv$stack, format.default, character(1)) - if (! ndl %in% nms) { + if (!ndl %in% nms) { warning("No app to end") return() } diff --git a/R/assertions.R b/R/assertions.R index 0e4209a3..f161c8b5 100644 --- a/R/assertions.R +++ b/R/assertions.R @@ -1,4 +1,3 @@ - is_string <- function(x) { is.character(x) && length(x) == 1 && !is.na(x) } @@ -12,7 +11,9 @@ is_border_style <- function(x) { } is_padding_or_margin <- function(x) { - is.numeric(x) && length(x) %in% c(1, 4) && !anyNA(x) && + is.numeric(x) && + length(x) %in% c(1, 4) && + !anyNA(x) && all(as.integer(x) == x) } @@ -21,8 +22,7 @@ is_col <- function(x) { } is_count <- function(x) { - is.numeric(x) && length(x) == 1 && !is.na(x) && as.integer(x) == x && - x >= 0 + is.numeric(x) && length(x) == 1 && !is.na(x) && as.integer(x) == x && x >= 0 } is_tree_style <- function(x) { diff --git a/R/box-styles.R b/R/box-styles.R index ae7997fa..d99da431 100644 --- a/R/box-styles.R +++ b/R/box-styles.R @@ -1,14 +1,12 @@ - box_styles <- function() { - styles <- list( single = list( - top_left = "\u250c", - top_right = "\u2510", + top_left = "\u250c", + top_right = "\u2510", bottom_right = "\u2518", - bottom_left = "\u2514", - vertical = "\u2502", - horizontal = "\u2500" + bottom_left = "\u2514", + vertical = "\u2502", + horizontal = "\u2500" ), double = list( top_left = "\u2554", @@ -18,7 +16,7 @@ box_styles <- function() { vertical = "\u2551", horizontal = "\u2550" ), - round= list( + round = list( top_left = "\u256d", top_right = "\u256e", bottom_right = "\u256f", diff --git a/R/boxes.R b/R/boxes.R index 95da8bf1..c71c5d52 100644 --- a/R/boxes.R +++ b/R/boxes.R @@ -1,5 +1,3 @@ - - #' Draw a banner-like box in the console #' #' @details @@ -121,13 +119,20 @@ #' #' @export -boxx <- function(label, header = "", footer = "", - border_style = "single", padding = 1, margin = 0, - float = c("left", "center", "right"), - col = NULL, background_col = NULL, border_col = col, - align = c("left", "center", "right"), - width = console_width()) { - +boxx <- function( + label, + header = "", + footer = "", + border_style = "single", + padding = 1, + margin = 0, + float = c("left", "center", "right"), + col = NULL, + background_col = NULL, + border_col = col, + align = c("left", "center", "right"), + width = console_width() +) { label <- apply_style(as.character(label), col) widest <- max(ansi_nchar(label, "width"), 0) @@ -181,17 +186,27 @@ boxx <- function(label, header = "", footer = "", hdline <- paste0(header, strrep(chars$horizontal, content_width - hdw)) top <- color_border(paste0( strrep("\n", margin[3]), - mar_left, chars$top_left, hdline, chars$top_right + mar_left, + chars$top_left, + hdline, + chars$top_right )) ftline <- paste0(strrep(chars$horizontal, content_width - ftw), footer) bottom <- color_border(paste0( - mar_left, chars$bottom_left, ftline, chars$bottom_right, + mar_left, + chars$bottom_left, + ftline, + chars$bottom_right, strrep("\n", margin[1]) )) side <- color_border(chars$vertical) - middle <- paste0(mar_left, side, - color_content(paste0(pad_left, label, pad_right)), side) + middle <- paste0( + mar_left, + side, + color_content(paste0(pad_left, label, pad_right)), + side + ) box <- paste0(top, "\n", paste0(middle, collapse = "\n"), "\n", bottom) diff --git a/R/bullets.R b/R/bullets.R index 100db4f5..008d1071 100644 --- a/R/bullets.R +++ b/R/bullets.R @@ -1,4 +1,3 @@ - #' List of items #' #' It is often useful to print out a list of items, tasks a function or @@ -50,8 +49,12 @@ #' @family functions supporting inline markup #' @export -cli_bullets <- function(text, id = NULL, class = NULL, - .envir = parent.frame()) { +cli_bullets <- function( + text, + id = NULL, + class = NULL, + .envir = parent.frame() +) { cli__message( "bullets", list( diff --git a/R/cat.R b/R/cat.R index 5d8e05c0..aa38c187 100644 --- a/R/cat.R +++ b/R/cat.R @@ -27,9 +27,14 @@ cat_line <- function(..., col = NULL, background_col = NULL, file = stdout()) { #' @export #' @rdname cat_line -cat_bullet <- function(..., col = NULL, background_col = NULL, - bullet = "bullet", bullet_col = NULL, - file = stdout()) { +cat_bullet <- function( + ..., + col = NULL, + background_col = NULL, + bullet = "bullet", + bullet_col = NULL, + file = stdout() +) { out <- apply_style(paste0(...), col) bullet <- apply_style(symbol[[bullet]], bullet_col) diff --git a/R/cli-errors.R b/R/cli-errors.R index 4843e9c0..ffdb7fdd 100644 --- a/R/cli-errors.R +++ b/R/cli-errors.R @@ -1,6 +1,10 @@ - -cli_error <- function(..., .data = NULL, .class = NULL, .envir = parent.frame(), - call. = TRUE) { +cli_error <- function( + ..., + .data = NULL, + .class = NULL, + .envir = parent.frame(), + call. = TRUE +) { .hide_from_trace <- TRUE cnd <- new_error( call. = call., @@ -18,8 +22,12 @@ cli_error <- function(..., .data = NULL, .class = NULL, .envir = parent.frame(), cnd } -stop_if_not <- function(message, ..., .envir = parent.frame(), - call. = sys.call(-1)) { +stop_if_not <- function( + message, + ..., + .envir = parent.frame(), + call. = sys.call(-1) +) { conds <- list(...) for (cond in conds) { if (!cond) { diff --git a/R/cli.R b/R/cli.R index bffc2266..b95ad5fe 100644 --- a/R/cli.R +++ b/R/cli.R @@ -1,4 +1,3 @@ - #' Compose multiple cli functions #' #' `cli()` will record all `cli_*` calls in `expr`, and emit them together @@ -44,8 +43,12 @@ cli__rec <- function(expr) { cli_recorded[[id]] } -cli__fmt <- function(record, collapse = FALSE, strip_newline = FALSE, - app = NULL) { +cli__fmt <- function( + record, + collapse = FALSE, + strip_newline = FALSE, + app = NULL +) { app <- app %||% default_app() %||% start_app(.auto_close = FALSE) old <- app$output @@ -112,8 +115,12 @@ cli_fmt <- function(expr, collapse = FALSE, strip_newline = FALSE) { #' @examples #' format_inline("A message for {.emph later}, thanks {.fn format_inline}.") -format_inline <- function(..., .envir = parent.frame(), collapse = TRUE, - keep_whitespace = TRUE) { +format_inline <- function( + ..., + .envir = parent.frame(), + collapse = TRUE, + keep_whitespace = TRUE +) { opts <- options(cli.width = Inf) on.exit(options(opts), add = TRUE) fun <- if (keep_whitespace) cli_inline else cli_text @@ -206,7 +213,10 @@ format_inline <- function(..., .envir = parent.frame(), collapse = TRUE, #' @export cli_text <- function(..., .envir = parent.frame()) { - cli__message("text", list(text = glue_cmd(..., .envir = .envir, .call = sys.call()))) + cli__message( + "text", + list(text = glue_cmd(..., .envir = .envir, .call = sys.call())) + ) } cli_inline <- function(..., .envir = parent.frame()) { @@ -355,10 +365,19 @@ cli_h3 <- function(text, id = NULL, class = NULL, .envir = parent.frame()) { #' #' @export -cli_div <- function(id = NULL, class = NULL, theme = NULL, - .auto_close = TRUE, .envir = parent.frame()) { - cli__message("div", list(id = id, class = class, theme = theme), - .auto_close = .auto_close, .envir = .envir) +cli_div <- function( + id = NULL, + class = NULL, + theme = NULL, + .auto_close = TRUE, + .envir = parent.frame() +) { + cli__message( + "div", + list(id = id, class = class, theme = theme), + .auto_close = .auto_close, + .envir = .envir + ) } #' CLI paragraph @@ -383,10 +402,18 @@ cli_div <- function(id = NULL, class = NULL, theme = NULL, #' #' @export -cli_par <- function(id = NULL, class = NULL, .auto_close = TRUE, - .envir = parent.frame()) { - cli__message("par", list(id = id, class = class), - .auto_close = .auto_close, .envir = .envir) +cli_par <- function( + id = NULL, + class = NULL, + .auto_close = TRUE, + .envir = parent.frame() +) { + cli__message( + "par", + list(id = id, class = class), + .auto_close = .auto_close, + .envir = .envir + ) } #' Close a CLI container @@ -500,10 +527,14 @@ cli_end <- function(id = NULL) { #' @family functions supporting inline markup #' @export - -cli_ul <- function(items = NULL, id = NULL, class = NULL, - .close = TRUE, .auto_close = TRUE, - .envir = parent.frame()) { +cli_ul <- function( + items = NULL, + id = NULL, + class = NULL, + .close = TRUE, + .auto_close = TRUE, + .envir = parent.frame() +) { cli__message( "ul", list( @@ -512,7 +543,8 @@ cli_ul <- function(items = NULL, id = NULL, class = NULL, class = class, .close = .close ), - .auto_close = .auto_close, .envir = .envir + .auto_close = .auto_close, + .envir = .envir ) } @@ -567,9 +599,14 @@ cli_ul <- function(items = NULL, id = NULL, class = NULL, #' @family functions supporting inline markup #' @export -cli_ol <- function(items = NULL, id = NULL, class = NULL, - .close = TRUE, .auto_close = TRUE, - .envir = parent.frame()) { +cli_ol <- function( + items = NULL, + id = NULL, + class = NULL, + .close = TRUE, + .auto_close = TRUE, + .envir = parent.frame() +) { cli__message( "ol", list( @@ -578,7 +615,8 @@ cli_ol <- function(items = NULL, id = NULL, class = NULL, class = class, .close = .close ), - .auto_close = .auto_close, .envir = .envir + .auto_close = .auto_close, + .envir = .envir ) } @@ -619,9 +657,15 @@ cli_ol <- function(items = NULL, id = NULL, class = NULL, #' @family functions supporting inline markup #' @export -cli_dl <- function(items = NULL, labels = names(items), id = NULL, - class = NULL, .close = TRUE, .auto_close = TRUE, - .envir = parent.frame()) { +cli_dl <- function( + items = NULL, + labels = names(items), + id = NULL, + class = NULL, + .close = TRUE, + .auto_close = TRUE, + .envir = parent.frame() +) { if (!is.null(items) && !is_named(items)) { throw(cli_error( "{.arg items} must be a named character vector", @@ -634,11 +678,15 @@ cli_dl <- function(items = NULL, labels = names(items), id = NULL, list( items = lapply(items, glue_cmd, .envir = .envir, .call = sys.call()), labels = if (!is.null(labels)) { - lapply(labels, glue_cmd, .envir = .envir, .call = sys.call()) - }, + lapply(labels, glue_cmd, .envir = .envir, .call = sys.call()) + }, id = id, - class = class, .close = .close), - .auto_close = .auto_close, .envir = .envir) + class = class, + .close = .close + ), + .auto_close = .auto_close, + .envir = .envir + ) } #' CLI list item(s) @@ -674,19 +722,27 @@ cli_dl <- function(items = NULL, labels = names(items), id = NULL, #' @family functions supporting inline markup #' @export -cli_li <- function(items = NULL, labels = names(items), id = NULL, - class = NULL, .auto_close = TRUE, - .envir = parent.frame()) { +cli_li <- function( + items = NULL, + labels = names(items), + id = NULL, + class = NULL, + .auto_close = TRUE, + .envir = parent.frame() +) { cli__message( "li", list( items = lapply(items, glue_cmd, .envir = .envir, .call = sys.call()), labels = if (!is.null(labels)) { - lapply(labels, glue_cmd, .envir = .envir, .call = sys.call()) - }, + lapply(labels, glue_cmd, .envir = .envir, .call = sys.call()) + }, id = id, - class = class), - .auto_close = .auto_close, .envir = .envir) + class = class + ), + .auto_close = .auto_close, + .envir = .envir + ) } #' CLI alerts @@ -743,8 +799,13 @@ cli_li <- function(items = NULL, labels = names(items), id = NULL, #' @family functions supporting inline markup #' @export -cli_alert <- function(text, id = NULL, class = NULL, wrap = FALSE, - .envir = parent.frame()) { +cli_alert <- function( + text, + id = NULL, + class = NULL, + wrap = FALSE, + .envir = parent.frame() +) { cli__message( "alert", list( @@ -759,8 +820,13 @@ cli_alert <- function(text, id = NULL, class = NULL, wrap = FALSE, #' @rdname cli_alert #' @export -cli_alert_success <- function(text, id = NULL, class = NULL, wrap = FALSE, - .envir = parent.frame()) { +cli_alert_success <- function( + text, + id = NULL, + class = NULL, + wrap = FALSE, + .envir = parent.frame() +) { cli__message( "alert_success", list( @@ -775,8 +841,13 @@ cli_alert_success <- function(text, id = NULL, class = NULL, wrap = FALSE, #' @rdname cli_alert #' @export -cli_alert_danger <- function(text, id = NULL, class = NULL, wrap = FALSE, - .envir = parent.frame()) { +cli_alert_danger <- function( + text, + id = NULL, + class = NULL, + wrap = FALSE, + .envir = parent.frame() +) { cli__message( "alert_danger", list( @@ -791,8 +862,13 @@ cli_alert_danger <- function(text, id = NULL, class = NULL, wrap = FALSE, #' @rdname cli_alert #' @export -cli_alert_warning <- function(text, id = NULL, class = NULL, wrap = FALSE, - .envir = parent.frame()) { +cli_alert_warning <- function( + text, + id = NULL, + class = NULL, + wrap = FALSE, + .envir = parent.frame() +) { cli__message( "alert_warning", list( @@ -807,8 +883,13 @@ cli_alert_warning <- function(text, id = NULL, class = NULL, wrap = FALSE, #' @rdname cli_alert #' @export -cli_alert_info <- function(text, id = NULL, class = NULL, wrap = FALSE, - .envir = parent.frame()) { +cli_alert_info <- function( + text, + id = NULL, + class = NULL, + wrap = FALSE, + .envir = parent.frame() +) { cli__message( "alert_info", list( @@ -860,12 +941,22 @@ cli_alert_info <- function(text, id = NULL, class = NULL, wrap = FALSE, #' @family functions supporting inline markup #' @export -cli_rule <- function(left = "", center = "", right = "", id = NULL, - .envir = parent.frame()) { - cli__message("rule", list(left = glue_cmd(left, .envir = .envir, .call = sys.call()), - center = glue_cmd(center, .envir = .envir, .call = sys.call()), - right = glue_cmd(right, .envir = .envir, .call = sys.call()), - id = id)) +cli_rule <- function( + left = "", + center = "", + right = "", + id = NULL, + .envir = parent.frame() +) { + cli__message( + "rule", + list( + left = glue_cmd(left, .envir = .envir, .call = sys.call()), + center = glue_cmd(center, .envir = .envir, .call = sys.call()), + right = glue_cmd(right, .envir = .envir, .call = sys.call()), + id = id + ) + ) } #' CLI block quote @@ -892,8 +983,13 @@ cli_rule <- function(left = "", center = "", right = "", id = NULL, #' @family functions supporting inline markup #' @export -cli_blockquote <- function(quote, citation = NULL, id = NULL, - class = NULL, .envir = parent.frame()) { +cli_blockquote <- function( + quote, + citation = NULL, + id = NULL, + class = NULL, + .envir = parent.frame() +) { cli__message( "blockquote", list( @@ -941,8 +1037,13 @@ cli_blockquote <- function(quote, citation = NULL, id = NULL, #' #' @export -cli_code <- function(lines = NULL, ..., language = "R", - .auto_close = TRUE, .envir = environment()) { +cli_code <- function( + lines = NULL, + ..., + language = "R", + .auto_close = TRUE, + .envir = environment() +) { lines <- c(lines, unlist(list(...))) id <- cli_div( class = paste("code", language), @@ -955,15 +1056,22 @@ cli_code <- function(lines = NULL, ..., language = "R", cli_recorded <- new.env(parent = emptyenv()) -cli__message <- function(type, args, .auto_close = TRUE, .envir = NULL, - record = getOption("cli.record")) { - +cli__message <- function( + type, + args, + .auto_close = TRUE, + .envir = NULL, + record = getOption("cli.record") +) { if ("id" %in% names(args) && is.null(args$id)) args$id <- new_uuid() if (.auto_close && !is.null(.envir) && !identical(.envir, .GlobalEnv)) { if (type == "status") { - defer(cli_status_clear(id = args$id, result = args$auto_result), - envir = .envir, priority = "first") + defer( + cli_status_clear(id = args$id, result = args$auto_result), + envir = .envir, + priority = "first" + ) } else { defer(cli_end(id = args$id), envir = .envir, priority = "first") } @@ -981,8 +1089,12 @@ cli__message <- function(type, args, .auto_close = TRUE, .envir = NULL, } cli__message_create <- function(type, args) { - cond <- list(message = paste("cli message", type), - type = type, args = args, pid = clienv$pid) + cond <- list( + message = paste("cli message", type), + type = type, + args = args, + pid = clienv$pid + ) class(cond) <- c( getOption("cli.message_class"), @@ -995,11 +1107,12 @@ cli__message_create <- function(type, args) { cli__message_emit <- function(cond) { withRestarts( - { - signalCondition(cond) - cli__default_handler(cond) - }, - cli_message_handled = function() NULL) + { + signalCondition(cond) + cli__default_handler(cond) + }, + cli_message_handled = function() NULL + ) } cli__default_handler <- function(msg) { diff --git a/R/cliapp-docs.R b/R/cliapp-docs.R index 1101344d..51903edd 100644 --- a/R/cliapp-docs.R +++ b/R/cliapp-docs.R @@ -1,4 +1,3 @@ - #' @title About inline markup in the semantic cli #' #' @description diff --git a/R/cliapp.R b/R/cliapp.R index 5db0b0a0..79bf13f1 100644 --- a/R/cliapp.R +++ b/R/cliapp.R @@ -1,8 +1,8 @@ - -cliapp <- function(theme = getOption("cli.theme"), - user_theme = getOption("cli.user_theme"), - output = c("auto", "message", "stdout", "stderr")) { - +cliapp <- function( + theme = getOption("cli.theme"), + user_theme = getOption("cli.user_theme"), + output = c("auto", "message", "stdout", "stderr") +) { app <- new_class( "cliapp", @@ -12,52 +12,45 @@ cliapp <- function(theme = getOption("cli.theme"), ## Meta meta = function(...) { txt <- cli__fmt(list(...), collapse = TRUE, app = app) - clii__message(txt, appendLF = FALSE, output = app$output, signal = app$signal) + clii__message( + txt, + appendLF = FALSE, + output = app$output, + signal = app$signal + ) }, ## Themes - list_themes = function() - clii_list_themes(app), - add_theme = function(theme) - clii_add_theme(app, theme), - remove_theme = function(id) - clii_remove_theme(app, id), + list_themes = function() clii_list_themes(app), + add_theme = function(theme) clii_add_theme(app, theme), + remove_theme = function(id) clii_remove_theme(app, id), ## Close container(s) - end = function(id = NULL) - clii_end(app, id), + end = function(id = NULL) clii_end(app, id), ## Generic container div = function(id = NULL, class = NULL, theme = NULL) clii_div(app, id, class, theme), ## Paragraphs - par = function(id = NULL, class = NULL) - clii_par(app, id, class), + par = function(id = NULL, class = NULL) clii_par(app, id, class), ## Text, wrapped - text = function(text) - clii_text(app, text), + text = function(text) clii_text(app, text), ## Text, not wrapped - inline_text = function(text) - clii_inline_text(app, text), + inline_text = function(text) clii_inline_text(app, text), ## Text, not wrapped, verbatim - verbatim = function(...) - clii_verbatim(app, ...), + verbatim = function(...) clii_verbatim(app, ...), ## Markdow(ish) text, wrapped: emphasis, strong emphasis, links, code - md_text = function(...) - clii_md_text(app, ...), + md_text = function(...) clii_md_text(app, ...), ## Headings - h1 = function(text, id = NULL, class = NULL) - clii_h1(app, text, id, class), - h2 = function(text, id = NULL, class = NULL) - clii_h2(app, text, id, class), - h3 = function(text, id = NULL, class = NULL) - clii_h3(app, text, id, class), + h1 = function(text, id = NULL, class = NULL) clii_h1(app, text, id, class), + h2 = function(text, id = NULL, class = NULL) clii_h2(app, text, id, class), + h3 = function(text, id = NULL, class = NULL) clii_h3(app, text, id, class), ## Block quote blockquote = function(quote, citation = NULL, id, class = NULL) @@ -68,8 +61,13 @@ cliapp <- function(theme = getOption("cli.theme"), clii_ul(app, items, id, class, .close), ol = function(items = NULL, id = NULL, class = NULL, .close = TRUE) clii_ol(app, items, id, class, .close), - dl = function(items = NULL, labels = NULL, id = NULL, class = NULL, .close = TRUE) - clii_dl(app, items, labels, id, class, .close), + dl = function( + items = NULL, + labels = NULL, + id = NULL, + class = NULL, + .close = TRUE + ) clii_dl(app, items, labels, id, class, .close), li = function(items = NULL, labels = NULL, id = NULL, class = NULL) clii_li(app, items, labels, id, class), @@ -98,11 +96,31 @@ cliapp <- function(theme = getOption("cli.theme"), clii_rule(app, left, center, right, id), ## Status bar - status = function(id = NULL, msg, msg_done = NULL, msg_failed = NULL, - keep = FALSE, auto_result = "clear", globalenv = FALSE) - clii_status(app, id, msg, msg_done, msg_failed, keep, auto_result, globalenv), - status_clear = function(id = NULL, result, msg_done = NULL, msg_failed = NULL) - clii_status_clear(app, id, result, msg_done, msg_failed), + status = function( + id = NULL, + msg, + msg_done = NULL, + msg_failed = NULL, + keep = FALSE, + auto_result = "clear", + globalenv = FALSE + ) + clii_status( + app, + id, + msg, + msg_done, + msg_failed, + keep, + auto_result, + globalenv + ), + status_clear = function( + id = NULL, + result, + msg_done = NULL, + msg_failed = NULL + ) clii_status_clear(app, id, result, msg_done, msg_failed), status_update = function(id = NULL, msg, msg_done = NULL, msg_failed = NULL) clii_status_update(app, id, msg, msg_done, msg_failed), @@ -115,15 +133,25 @@ cliapp <- function(theme = getOption("cli.theme"), margin = 0, output = NULL, - get_current_style = function() - utils::tail(app$styles, 1)[[1]], - - xtext = function(text = NULL, .list = NULL, indent = 0, padding = 0, wrap = TRUE) - clii__xtext(app, text, .list = .list, indent = indent, - padding = padding, wrap = wrap), - - vspace = function(n = 1) - clii__vspace(app, n), + get_current_style = function() utils::tail(app$styles, 1)[[1]], + + xtext = function( + text = NULL, + .list = NULL, + indent = 0, + padding = 0, + wrap = TRUE + ) + clii__xtext( + app, + text, + .list = .list, + indent = indent, + padding = padding, + wrap = wrap + ), + + vspace = function(n = 1) clii__vspace(app, n), inline = function(text = NULL, .list = NULL) clii__inline(app, text, .list = .list), @@ -131,15 +159,13 @@ cliapp <- function(theme = getOption("cli.theme"), item_text = function(type, name, cnt_id, items = list(), .list = NULL) clii__item_text(app, type, name, cnt_id, items, .list = .list), - get_width = function(extra = 0) - clii__get_width(app, extra), - cat = function(lines) - clii__cat(app, lines), + get_width = function(extra = 0) clii__get_width(app, extra), + cat = function(lines) clii__cat(app, lines), cat_ln = function(lines, indent = 0, padding = 0) clii__cat_ln(app, lines, indent, padding) ) - if (! inherits(output, "connection")) output <- match.arg(output) + if (!inherits(output, "connection")) output <- match.arg(output) app$new(theme, user_theme, output) app @@ -247,8 +273,12 @@ clii_rule <- function(app, left, center, right, id) { ## Alerts ----------------------------------------------------------- clii_alert <- function(app, type, text, id, class, wrap) { - clii__container_start(app, "div", id = id, - class = paste(class, "alert", type)) + clii__container_start( + app, + "div", + id = id, + class = paste(class, "alert", type) + ) on.exit(clii__container_end(app, id), add = TRUE) if (wrap) { app$xtext(text) @@ -269,7 +299,12 @@ clii_alert <- function(app, type, text, id, class, wrap) { ## Bullets ------------------------------------------------------------- clii_bullets <- function(app, text, id, class) { - clii__container_start(app, "div", id = id, class = paste("memo bullets", class)) + clii__container_start( + app, + "div", + id = id, + class = paste("memo bullets", class) + ) on.exit(clii__container_end(app, id), add = TRUE) # Normalize names a bit, so we can use them as class names diff --git a/R/containers.R b/R/containers.R index e6fac580..d719f440 100644 --- a/R/containers.R +++ b/R/containers.R @@ -1,17 +1,19 @@ - add_child <- function(x, tag, ...) { push(x, list(tag = tag, ...)) } -clii__container_start <- function(app, tag, class = NULL, - id = NULL, theme = NULL) { - +clii__container_start <- function( + app, + tag, + class = NULL, + id = NULL, + theme = NULL +) { id <- id %||% new_uuid() if (!length(class)) class <- "" class <- setdiff(unique(strsplit(class, " ", fixed = TRUE)[[1]]), "") - app$doc <- add_child(app$doc, tag, id = id, class = class, - theme = theme) + app$doc <- add_child(app$doc, tag, id = id, class = class, theme = theme) ## Go over all themes, and collect the selectors that match the ## current element @@ -54,10 +56,10 @@ clii__container_end <- function(app, id) { } ## ids to remove - del_ids <- unlist(lapply(utils::tail(app$doc, - (wh - 1L)), "[[", "id")) + del_ids <- unlist(lapply(utils::tail(app$doc, -(wh - 1L)), "[[", "id")) ## themes to remove - del_thm <- unlist(lapply(utils::tail(app$doc, - (wh - 1L)), "[[", "theme")) + del_thm <- unlist(lapply(utils::tail(app$doc, -(wh - 1L)), "[[", "theme")) ## Remove the whole subtree of 'cnt' app$doc <- utils::head(app$doc, wh - 1L) @@ -103,19 +105,28 @@ clii_par <- function(app, id, class) { clii_ul <- function(app, items, id, class, .close) { id <- clii__container_start(app, "ul", id = id, class = class) - if (length(items)) { app$li(items); if (.close) app$end(id) } + if (length(items)) { + app$li(items) + if (.close) app$end(id) + } invisible(id) } clii_ol <- function(app, items, id, class, .close) { id <- clii__container_start(app, "ol", id = id, class = class) - if (length(items)) { app$li(items); if (.close) app$end(id) } + if (length(items)) { + app$li(items) + if (.close) app$end(id) + } invisible(id) } clii_dl <- function(app, items, labels, id, class, .close) { id <- clii__container_start(app, "dl", id = id, class = class) - if (length(items)) { app$li(items, labels); if (.close) app$end(id) } + if (length(items)) { + app$li(items, labels) + if (.close) app$end(id) + } invisible(id) } @@ -124,13 +135,15 @@ clii_li <- function(app, items, labels, id, class) { ## check the last active list container last <- length(app$doc) - while (! app$doc[[last]]$tag %in% c("ul", "ol", "dl", "body")) { + while (!app$doc[[last]]$tag %in% c("ul", "ol", "dl", "body")) { last <- last - 1L } ## if not the last container, close the ones below it - if (app$doc[[last]]$tag != "body" && - last != length(app$doc)) { + if ( + app$doc[[last]]$tag != "body" && + last != length(app$doc) + ) { app$end(app$doc[[last + 1L]]$id) } @@ -158,7 +171,6 @@ clii_li <- function(app, items, labels, id, class) { } clii__item_text <- function(app, type, name, cnt_id, text, .list) { - style <- app$get_current_style() cnt_style <- app$styles[[cnt_id]] @@ -179,7 +191,7 @@ clii__item_text <- function(app, type, name, cnt_id, text, .list) { app$xtext( .list = c(list(head), list(text), .list), - indent = - (style$`padding-left` %||% 0), + indent = -(style$`padding-left` %||% 0), padding = (cnt_style$`padding-left` %||% 0) ) } diff --git a/R/debug.R b/R/debug.R index 6943ca97..ca903fbb 100644 --- a/R/debug.R +++ b/R/debug.R @@ -1,4 +1,3 @@ - #' Debug cli internals #' #' Return the current state of a cli app. It includes the currently @@ -43,10 +42,10 @@ cli_debug_doc <- function(app = default_app() %||% start_app()) { df <- data.frame( stringsAsFactors = FALSE, - tag = tgs, - id = ids, - class = cls, - theme = I(as.list(thm)), + tag = tgs, + id = ids, + class = cls, + theme = I(as.list(thm)), styles = I(as.list(unname(app$styles))) ) @@ -58,14 +57,17 @@ cli_debug_doc <- function(app = default_app() %||% start_app()) { format.cli_doc <- function(x, ...) { nz <- nrow(x) > 0 - c("", + c( + "", paste0( if (nz) "<", x$tag, - if (nz) " id=\"", x$id, if (nz) "\"", - ifelse (x$class == "", "", paste0(" class=\"", x$class, "\"")), + if (nz) " id=\"", + x$id, + if (nz) "\"", + ifelse(x$class == "", "", paste0(" class=\"", x$class, "\"")), if (nz) ">", - ifelse (vlapply(x$theme, is.null), "", " +theme") + ifelse(vlapply(x$theme, is.null), "", " +theme") ) ) } diff --git a/R/defer.R b/R/defer.R index ff42606a..280ebf48 100644 --- a/R/defer.R +++ b/R/defer.R @@ -1,4 +1,3 @@ - # NOTE: patched to use `cli_error()` # nocov start --- compat-defer --- @@ -12,222 +11,228 @@ # infinite recursion issues. # * The handler list is now soft-namespaced. - -defer <- function(expr, envir = parent.frame(), priority = c("first", "last")) { } +defer <- function(expr, envir = parent.frame(), priority = c("first", "last")) { +} local({ - -defer <<- defer <- function(expr, envir = parent.frame(), priority = c("first", "last")) { - priority <- match.arg(priority) - invisible( - add_handler( - envir, - handler = new_handler(substitute(expr), parent.frame()), - front = priority == "first" + defer <<- defer <- function( + expr, + envir = parent.frame(), + priority = c("first", "last") + ) { + priority <- match.arg(priority) + invisible( + add_handler( + envir, + handler = new_handler(substitute(expr), parent.frame()), + front = priority == "first" + ) ) - ) -} - -new_handler <- function(expr, envir) { - hnd <- new.env(FALSE, size = 2) - hnd[["expr"]] <- expr - hnd[["envir"]] <- envir - hnd -} - -add_handler <- function(envir, - handler, - front, - frames = as.list(sys.frames()), - calls = as.list(sys.calls())) { - envir <- exit_frame(envir, frames, calls) + } - if (front) { - handlers <- c(list(handler), get_handlers(envir)) - } else { - handlers <- c(get_handlers(envir), list(handler)) + new_handler <- function(expr, envir) { + hnd <- new.env(FALSE, size = 2) + hnd[["expr"]] <- expr + hnd[["envir"]] <- envir + hnd } - set_handlers(envir, handlers, frames = frames, calls = calls) - handler -} + add_handler <- function( + envir, + handler, + front, + frames = as.list(sys.frames()), + calls = as.list(sys.calls()) + ) { + envir <- exit_frame(envir, frames, calls) -set_handlers <- function(envir, handlers, frames, calls) { - if (is.null(get_handlers(envir))) { - # Ensure that list of handlers called when environment "ends" - setup_handlers(envir) - } + if (front) { + handlers <- c(list(handler), get_handlers(envir)) + } else { + handlers <- c(get_handlers(envir), list(handler)) + } - attr(envir, "withr_handlers") <- handlers -} + set_handlers(envir, handlers, frames = frames, calls = calls) + handler + } -# Evaluate `frames` lazily -setup_handlers <- function(envir, - frames = as.list(sys.frames()), - calls = as.list(sys.calls())) { - if (is_top_level_global_env(envir, frames)) { - # For session scopes we use reg.finalizer() - if (is_interactive()) { - message( - sprintf("Setting global deferred event(s).\n"), - "i These will be run:\n", - " * Automatically, when the R session ends.\n", - " * On demand, if you call `withr::deferred_run()`.\n", - "i Use `withr::deferred_clear()` to clear them without executing." - ) + set_handlers <- function(envir, handlers, frames, calls) { + if (is.null(get_handlers(envir))) { + # Ensure that list of handlers called when environment "ends" + setup_handlers(envir) } - reg.finalizer(envir, function(env) deferred_run(env), onexit = TRUE) - } else { - # for everything else we use on.exit() - call <- make_call(execute_handlers, envir) - # We have to use do.call here instead of eval because of the way on.exit - # determines its evaluation context - # (https://stat.ethz.ch/pipermail/r-devel/2013-November/067867.html) + attr(envir, "withr_handlers") <- handlers + } + + # Evaluate `frames` lazily + setup_handlers <- function( + envir, + frames = as.list(sys.frames()), + calls = as.list(sys.calls()) + ) { + if (is_top_level_global_env(envir, frames)) { + # For session scopes we use reg.finalizer() + if (is_interactive()) { + message( + sprintf("Setting global deferred event(s).\n"), + "i These will be run:\n", + " * Automatically, when the R session ends.\n", + " * On demand, if you call `withr::deferred_run()`.\n", + "i Use `withr::deferred_clear()` to clear them without executing." + ) + } + reg.finalizer(envir, function(env) deferred_run(env), onexit = TRUE) + } else { + # for everything else we use on.exit() - do.call(base::on.exit, list(call, TRUE), envir = envir) - } -} + call <- make_call(execute_handlers, envir) + # We have to use do.call here instead of eval because of the way on.exit + # determines its evaluation context + # (https://stat.ethz.ch/pipermail/r-devel/2013-November/067867.html) -exit_frame <- function(envir, - frames = as.list(sys.frames()), - calls = as.list(sys.calls())) { - frame_loc <- frame_loc(envir, frames) - if (!frame_loc) { - return(envir) + do.call(base::on.exit, list(call, TRUE), envir = envir) + } } - if (in_knitr(envir)) { - out <- knitr_frame(envir, frames, calls, frame_loc) + exit_frame <- function( + envir, + frames = as.list(sys.frames()), + calls = as.list(sys.calls()) + ) { + frame_loc <- frame_loc(envir, frames) + if (!frame_loc) { + return(envir) + } + + if (in_knitr(envir)) { + out <- knitr_frame(envir, frames, calls, frame_loc) + if (!is.null(out)) { + return(out) + } + } + + out <- source_frame(envir, frames, calls, frame_loc) if (!is.null(out)) { return(out) } - } - out <- source_frame(envir, frames, calls, frame_loc) - if (!is.null(out)) { - return(out) + envir } - envir -} - -knitr_frame <- function(envir, frames, calls, frame_loc) { - knitr_ns <- asNamespace("knitr") + knitr_frame <- function(envir, frames, calls, frame_loc) { + knitr_ns <- asNamespace("knitr") - # This doesn't handle correctly the recursive case (knitr called - # within a chunk). Handling this would be a little fiddly for an - # uncommon edge case. - for (i in seq(1, frame_loc)) { - if (identical(topenv(frames[[i]]), knitr_ns)) { - return(frames[[i]]) + # This doesn't handle correctly the recursive case (knitr called + # within a chunk). Handling this would be a little fiddly for an + # uncommon edge case. + for (i in seq(1, frame_loc)) { + if (identical(topenv(frames[[i]]), knitr_ns)) { + return(frames[[i]]) + } } - } - - NULL -} - -source_frame <- function(envir, frames, calls, frame_loc) { - i <- frame_loc - if (i < 4) { - return(NULL) + NULL } - is_call <- function(x, fn) { - is.call(x) && identical(x[[1]], fn) - } - calls <- as.list(calls) + source_frame <- function(envir, frames, calls, frame_loc) { + i <- frame_loc - if (!is_call(calls[[i - 3]], quote(source))) { - return(NULL) - } - if (!is_call(calls[[i - 2]], quote(withVisible))) { - return(NULL) - } - if (!is_call(calls[[i - 1]], quote(eval))) { - return(NULL) - } - if (!is_call(calls[[i - 0]], quote(eval))) { - return(NULL) - } - - frames[[i - 3]] -} + if (i < 4) { + return(NULL) + } -frame_loc <- function(envir, frames) { - n <- length(frames) - if (!n) { - return(0) - } + is_call <- function(x, fn) { + is.call(x) && identical(x[[1]], fn) + } + calls <- as.list(calls) - for (i in seq_along(frames)) { - if (identical(frames[[n - i + 1]], envir)) { - return(n - i + 1) + if (!is_call(calls[[i - 3]], quote(source))) { + return(NULL) + } + if (!is_call(calls[[i - 2]], quote(withVisible))) { + return(NULL) + } + if (!is_call(calls[[i - 1]], quote(eval))) { + return(NULL) + } + if (!is_call(calls[[i - 0]], quote(eval))) { + return(NULL) } + + frames[[i - 3]] } - 0 -} + frame_loc <- function(envir, frames) { + n <- length(frames) + if (!n) { + return(0) + } -in_knitr <- function(envir) { - knitr_in_progress() && identical(knitr::knit_global(), envir) -} + for (i in seq_along(frames)) { + if (identical(frames[[n - i + 1]], envir)) { + return(n - i + 1) + } + } -is_top_level_global_env <- function(envir, frames) { - if (!identical(envir, globalenv())) { - return(FALSE) + 0 } - # Check if another global environment is on the stack - !any(vapply(frames, identical, NA, globalenv())) -} + in_knitr <- function(envir) { + knitr_in_progress() && identical(knitr::knit_global(), envir) + } -get_handlers <- function(envir) { - attr(envir, "withr_handlers") -} + is_top_level_global_env <- function(envir, frames) { + if (!identical(envir, globalenv())) { + return(FALSE) + } -execute_handlers <- function(envir) { - handlers <- get_handlers(envir) - errors <- list() - for (handler in handlers) { - tryCatch(eval(handler$expr, handler$envir), - error = function(e) { - errors[[length(errors) + 1]] <<- e - } - ) + # Check if another global environment is on the stack + !any(vapply(frames, identical, NA, globalenv())) } - attr(envir, "withr_handlers") <- NULL - for (error in errors) { - stop(error) %??% - cli_error("Error in a deferred {.code on.exit()} clause") + get_handlers <- function(envir) { + attr(envir, "withr_handlers") } -} -make_call <- function(...) { - as.call(list(...)) -} + execute_handlers <- function(envir) { + handlers <- get_handlers(envir) + errors <- list() + for (handler in handlers) { + tryCatch(eval(handler$expr, handler$envir), error = function(e) { + errors[[length(errors) + 1]] <<- e + }) + } + attr(envir, "withr_handlers") <- NULL -# base implementation of rlang::is_interactive() -is_interactive <- function() { - opt <- getOption("rlang_interactive") - if (!is.null(opt)) { - return(opt) - } - if (knitr_in_progress()) { - return(FALSE) + for (error in errors) { + stop(error) %??% + cli_error("Error in a deferred {.code on.exit()} clause") + } } - if (identical(Sys.getenv("TESTTHAT"), "true")) { - return(FALSE) + + make_call <- function(...) { + as.call(list(...)) } - interactive() -} -knitr_in_progress <- function() { - isTRUE(getOption("knitr.in.progress")) -} + # base implementation of rlang::is_interactive() + is_interactive <- function() { + opt <- getOption("rlang_interactive") + if (!is.null(opt)) { + return(opt) + } + if (knitr_in_progress()) { + return(FALSE) + } + if (identical(Sys.getenv("TESTTHAT"), "true")) { + return(FALSE) + } + interactive() + } + knitr_in_progress <- function() { + isTRUE(getOption("knitr.in.progress")) + } }) # defer() namespace # nocov end diff --git a/R/diff.R b/R/diff.R index 7a74cfa3..d6165ca7 100644 --- a/R/diff.R +++ b/R/diff.R @@ -1,4 +1,3 @@ - #' Compare two character vectors elementwise #' #' Its printed output is similar to calling `diff -u` at the command @@ -144,12 +143,12 @@ get_diff_chunks <- function(lcs, context = 3L) { } chunks <- data.frame( - op_begin = integer(nchunks), # first op in chunk - op_length = integer(nchunks), # number of operations in chunk - old_begin = integer(nchunks), # first line from `old` in chunk - old_length = integer(nchunks), # number of lines from `old` in chunk - new_begin = integer(nchunks), # first line from `new` in chunk - new_length = integer(nchunks) # number of lines from `new` in chunk + op_begin = integer(nchunks), # first op in chunk + op_length = integer(nchunks), # number of operations in chunk + old_begin = integer(nchunks), # first line from `old` in chunk + old_length = integer(nchunks), # number of lines from `old` in chunk + new_begin = integer(nchunks), # first line from `new` in chunk + new_length = integer(nchunks) # number of lines from `new` in chunk ) if (nchunks == 0) return(chunks) @@ -167,7 +166,7 @@ get_diff_chunks <- function(lcs, context = 3L) { # chunk starts at operation number sum(length) before it, plus 1, but # at the end we change this to include the context chunks are well - chunks$op_begin <- c(0, cumsum(runs$lengths))[which(runs$values)] + 1 + chunks$op_begin <- c(0, cumsum(runs$lengths))[which(runs$values)] + 1 chunks$op_length <- runs$lengths[runs$values] # `old` positions are from `old_off`, but need to fix the boundaries @@ -227,10 +226,8 @@ format_chunk <- function(x, chunks, num, context) { } } paste0(" ", x$old[off + 1:len]) - } else if (op == "delete") { col_blue(paste0("-", x$old[off + 1:len])) - } else if (op == "insert") { col_green(paste0("+", x$new[off + 1:len])) } @@ -265,10 +262,8 @@ format_diff_str_color <- function(x, ...) { len <- x$lcs$length[i] if (op == "match") { paste0(x$old[off + 1:len], collapse = "") - } else if (op == "delete") { bg_blue(col_black(paste0(x$old[off + 1:len], collapse = ""))) - } else if (op == "insert") { bg_green(col_black(paste0(x$new[off + 1:len], collapse = ""))) } @@ -284,10 +279,8 @@ format_diff_str_nocolor <- function(x, ...) { len <- x$lcs$length[i] if (op == "match") { paste0(x$old[off + 1:len], collapse = "") - } else if (op == "delete") { paste0(c("[-", x$old[off + 1:len], "-]"), collapse = "") - } else if (op == "insert") { paste0(c("{+", x$new[off + 1:len], "+}"), collapse = "") } diff --git a/R/docs.R b/R/docs.R index f9bca1d7..6b978490 100644 --- a/R/docs.R +++ b/R/docs.R @@ -1,4 +1,3 @@ - #' Frequently Asked Questions #' #' @name faq diff --git a/R/enc-utils.R b/R/enc-utils.R index 508637df..7ab6a960 100644 --- a/R/enc-utils.R +++ b/R/enc-utils.R @@ -1,4 +1,3 @@ - # keep encoding, even if useBytes = TRUE sub_ <- function(pattern, replacement, x, ...) { diff --git a/R/errors.R b/R/errors.R index c387db41..f7051a36 100644 --- a/R/errors.R +++ b/R/errors.R @@ -1,4 +1,3 @@ - # # Standalone file for better error handling ---------------------------- # # If can allow package dependencies, then you are probably better off @@ -161,7 +160,6 @@ # * Now we do not load packages when walking the trace. err <- local({ - # -- dependencies ----------------------------------------------------- rstudio_detect <- rstudio$detect @@ -188,7 +186,8 @@ err <- local({ message <- .makeMessage(..., domain = domain) structure( list(message = message, call = call., srcref = srcref), - class = c("condition")) + class = c("condition") + ) } #' Create a new error condition @@ -266,9 +265,11 @@ err <- local({ # baseenv(), so it is almost as if it was in baseenv() itself, like # .Last.value. We save the print methods here as well, and then they # will be found automatically. - if (! "org:r-lib" %in% search()) { - do.call("attach", list(new.env(), pos = length(search()), - name = "org:r-lib")) + if (!"org:r-lib" %in% search()) { + do.call( + "attach", + list(new.env(), pos = length(search()), name = "org:r-lib") + ) } env <- as.environment("org:r-lib") env$.Last.error <- cond @@ -279,13 +280,15 @@ err <- local({ # If this is not an error, then we'll just return here. This allows # throwing interrupt conditions for example, with the same UI. - if (! inherits(cond, "error")) return(invisible()) + if (!inherits(cond, "error")) return(invisible()) .hide_from_trace <- NULL # Top-level handler, this is intended for testing only for now, # and its design might change. - if (!is.null(th <- getOption("rlib_error_handler")) && - is.function(th)) { + if ( + !is.null(th <- getOption("rlib_error_handler")) && + is.function(th) + ) { return(th(cond)) } @@ -333,17 +336,20 @@ err <- local({ .hide_from_trace <- 1 force(call) srcref <- srcref %||% utils::getSrcref(sys.call()) - withCallingHandlers({ - expr - }, error = function(e) { - .hide_from_trace <- 0:1 - e$srcref <- srcref - e$procsrcref <- NULL - if (!inherits(err, "condition")) { - err <- new_error(err, call. = call) + withCallingHandlers( + { + expr + }, + error = function(e) { + .hide_from_trace <- 0:1 + e$srcref <- srcref + e$procsrcref <- NULL + if (!inherits(err, "condition")) { + err <- new_error(err, call. = call) + } + throw_error(err, parent = e) } - throw_error(err, parent = e) - }) + ) } # -- rethrowing conditions from C code --------------------------------- @@ -374,7 +380,13 @@ err <- local({ name <- native_name(.NAME) err <- new_error("Native call to `", name, "` failed", call. = call1) cerror <- if (inherits(e, "simpleError")) "c_error" - class(err) <- c(cerror, "rlib_error_3_0", "rlib_error", "error", "condition") + class(err) <- c( + cerror, + "rlib_error_3_0", + "rlib_error", + "error", + "condition" + ) throw_error(err, parent = e) } ) @@ -409,7 +421,13 @@ err <- local({ name <- native_name(.NAME) err <- new_error("Native call to `", name, "` failed", call. = call1) cerror <- if (inherits(e, "simpleError")) "c_error" - class(err) <- c(cerror, "rlib_error_3_0", "rlib_error", "error", "condition") + class(err) <- c( + cerror, + "rlib_error_3_0", + "rlib_error", + "error", + "condition" + ) throw_error(err, parent = e) } ) @@ -428,7 +446,6 @@ err <- local({ #' @return A condition object, with the trace added. add_trace_back <- function(cond, frame = NULL) { - idx <- seq_len(sys.parent(1L)) frames <- sys.frames()[idx] @@ -493,22 +510,29 @@ err <- local({ } is_operator <- function(cl) { - is.call(cl) && length(cl) >= 1 && is.symbol(cl[[1]]) && + is.call(cl) && + length(cl) >= 1 && + is.symbol(cl[[1]]) && grepl("^[^.a-zA-Z]", as.character(cl[[1]])) } mark_invisible_frames <- function(funs, frames) { visibles <- rep(TRUE, length(frames)) hide <- lapply(frames, "[[", ".hide_from_trace") - w_hide <- unlist(mapply(seq_along(hide), hide, FUN = function(i, w) { - i + w - }, SIMPLIFY = FALSE)) + w_hide <- unlist(mapply( + seq_along(hide), + hide, + FUN = function(i, w) { + i + w + }, + SIMPLIFY = FALSE + )) w_hide <- w_hide[w_hide <= length(frames)] visibles[w_hide] <- FALSE hide_from <- which(funs %in% names(invisible_frames)) for (start in hide_from) { - hide_this <- invisible_frames[[ funs[start] ]] + hide_this <- invisible_frames[[funs[start]]] for (i in seq_along(hide_this)) { if (start + i > length(funs)) break if (funs[start + i] != hide_this[i]) break @@ -525,7 +549,8 @@ err <- local({ "cli::cli_abort" = c( "rlang::abort", "rlang:::signal_abort", - "base::signalCondition"), + "base::signalCondition" + ), "rlang::abort" = c("rlang:::signal_abort", "base::signalCondition") ) @@ -546,12 +571,15 @@ err <- local({ get_call_scope <- function(call, ns) { if (is.na(ns)) return("global") if (!is.call(call)) return("") - if (is.call(call[[1]]) && - (call[[1]][[1]] == quote(`::`) || call[[1]][[1]] == quote(`:::`))) return("") + if ( + is.call(call[[1]]) && + (call[[1]][[1]] == quote(`::`) || call[[1]][[1]] == quote(`:::`)) + ) + return("") if (ns == "base") return("::") - if (! ns %in% loadedNamespaces()) return("") + if (!ns %in% loadedNamespaces()) return("") name <- call_name(call) - if (! ns %in% loadedNamespaces()) return("::") + if (!ns %in% loadedNamespaces()) return("::") nsenv <- asNamespace(ns)$.__NAMESPACE__. if (is.null(nsenv)) return("::") if (is.null(nsenv$exports)) return(":::") @@ -568,7 +596,16 @@ err <- local({ topenv(x, matchThisEnv = err_env) } - new_trace <- function (calls, parents, visibles, namespaces, scopes, srcrefs, procsrcrefs, pids) { + new_trace <- function( + calls, + parents, + visibles, + namespaces, + scopes, + srcrefs, + procsrcrefs, + pids + ) { trace <- data.frame( stringsAsFactors = FALSE, parent = parents, @@ -621,9 +658,15 @@ err <- local({ # -- S3 methods ------------------------------------------------------- - format_error <- function(x, trace = FALSE, class = FALSE, - advice = !trace, full = trace, header = TRUE, - ...) { + format_error <- function( + x, + trace = FALSE, + class = FALSE, + advice = !trace, + full = trace, + header = TRUE, + ... + ) { if (has_cli()) { format_error_cli(x, trace, class, advice, full, header, ...) } else { @@ -631,8 +674,7 @@ err <- local({ } } - print_error <- function(x, trace = TRUE, class = TRUE, - advice = !trace, ...) { + print_error <- function(x, trace = TRUE, class = TRUE, advice = !trace, ...) { writeLines(format_error(x, trace, class, advice, ...)) } @@ -728,12 +770,13 @@ err <- local({ paste0(if (add_exp) exp, msg), if (inherits(cond$parent, "condition")) { msg <- if (full && inherits(cond$parent, "rlib_error_3_0")) { - format(cond$parent, - trace = FALSE, - full = TRUE, - class = FALSE, - header = FALSE, - advice = FALSE + format( + cond$parent, + trace = FALSE, + full = TRUE, + class = FALSE, + header = FALSE, + advice = FALSE ) } else if (inherits(cond$parent, "interrupt")) { "interrupt" @@ -742,9 +785,7 @@ err <- local({ } add_exp <- substr(cli::ansi_strip(msg[1]), 1, 1) != "!" if (add_exp) msg[1] <- paste0(exp, msg[1]) - c(format_header_line_cli(cond$parent, prefix = "Caused by error"), - msg - ) + c(format_header_line_cli(cond$parent, prefix = "Caused by error"), msg) } ) } @@ -758,12 +799,13 @@ err <- local({ paste0(if (add_exp) exp, cnd_message_robust(cond)), if (inherits(cond$parent, "condition")) { msg <- if (full && inherits(cond$parent, "rlib_error_3_0")) { - format(cond$parent, - trace = FALSE, - full = TRUE, - class = FALSE, - header = FALSE, - advice = FALSE + format( + cond$parent, + trace = FALSE, + full = TRUE, + class = FALSE, + header = FALSE, + advice = FALSE ) } else if (inherits(cond$parent, "interrupt")) { "interrupt" @@ -774,7 +816,8 @@ err <- local({ if (add_exp) { msg[1] <- paste0(exp, msg[1]) } - c(format_header_line_plain(cond$parent, prefix = "Caused by error"), + c( + format_header_line_plain(cond$parent, prefix = "Caused by error"), msg ) } @@ -790,9 +833,15 @@ err <- local({ # - error message, just `conditionMessage()` # - advice about .Last.error and/or .Last.error.trace - format_error_cli <- function(x, trace = TRUE, class = TRUE, - advice = !trace, full = trace, - header = TRUE, ...) { + format_error_cli <- function( + x, + trace = TRUE, + class = TRUE, + advice = !trace, + full = trace, + header = TRUE, + ... + ) { p_class <- if (class) format_class_cli(x) p_header <- if (header) format_header_line_cli(x) p_msg <- cnd_message_cli(x, full) @@ -801,11 +850,7 @@ err <- local({ c("---", "Backtrace:", format_trace_cli(x$trace)) } - c(p_class, - p_header, - p_msg, - p_advice, - p_trace) + c(p_class, p_header, p_msg, p_advice, p_trace) } format_header_line_cli <- function(x, prefix = NULL) { @@ -892,7 +937,11 @@ err <- local({ srcref <- if ("srcref" %in% names(x) || "procsrcref" %in% names(x)) { vapply( seq_len(nrow(x)), - function(i) format_srcref_cli(x[["call"]][[i]], x$procsrcref[[i]] %||% x$srcref[[i]]), + function(i) + format_srcref_cli( + x[["call"]][[i]], + x$procsrcref[[i]] %||% x$srcref[[i]] + ), character(1) ) } else { @@ -901,11 +950,15 @@ err <- local({ lines <- paste0( cli::col_silver(format(x$num), ". "), - ifelse (visible, "", "| "), + ifelse(visible, "", "| "), scope, - vapply(seq_along(x$call), function(i) { - format_trace_call_cli(x$call[[i]], x$namespace[[i]]) - }, character(1)), + vapply( + seq_along(x$call), + function(i) { + format_trace_call_cli(x$call[[i]], x$namespace[[i]]) + }, + character(1) + ), srcref ) @@ -918,12 +971,17 @@ err <- local({ } format_trace_call_cli <- function(call, ns = "") { - envir <- tryCatch({ - if (!ns %in% loadedNamespaces()) stop("no") - asNamespace(ns) - }, error = function(e) .GlobalEnv) + envir <- tryCatch( + { + if (!ns %in% loadedNamespaces()) stop("no") + asNamespace(ns) + }, + error = function(e) .GlobalEnv + ) cl <- trimws(format(call)) - if (length(cl) > 1) { cl <- paste0(cl[1], " ", cli::symbol$ellipsis) } + if (length(cl) > 1) { + cl <- paste0(cl[1], " ", cli::symbol$ellipsis) + } # Older cli does not have 'envir'. if ("envir" %in% names(formals(cli::code_highlight))) { fmc <- cli::code_highlight(cl, envir = envir)[1] @@ -935,9 +993,15 @@ err <- local({ # ---------------------------------------------------------------------- - format_error_plain <- function(x, trace = TRUE, class = TRUE, - advice = !trace, full = trace, header = TRUE, - ...) { + format_error_plain <- function( + x, + trace = TRUE, + class = TRUE, + advice = !trace, + full = trace, + header = TRUE, + ... + ) { p_class <- if (class) format_class_plain(x) p_header <- if (header) format_header_line_plain(x) p_msg <- cnd_message_plain(x, full) @@ -946,11 +1010,7 @@ err <- local({ c("---", "Backtrace:", format_trace_plain(x$trace)) } - c(p_class, - p_header, - p_msg, - p_advice, - p_trace) + c(p_class, p_header, p_msg, p_advice, p_trace) } format_trace_plain <- function(x, ...) { @@ -971,7 +1031,11 @@ err <- local({ srcref <- if ("srcref" %in% names(x) || "procsrfref" %in% names(x)) { vapply( seq_len(nrow(x)), - function(i) format_srcref_plain(x[["call"]][[i]], x$procsrcref[[i]] %||% x$srcref[[i]]), + function(i) + format_srcref_plain( + x[["call"]][[i]], + x$procsrcref[[i]] %||% x$srcref[[i]] + ), character(1) ) } else { @@ -980,7 +1044,7 @@ err <- local({ lines <- paste0( paste0(format(x$num), ". "), - ifelse (visible, "", "| "), + ifelse(visible, "", "| "), scope, vapply(x[["call"]], format_trace_call_plain, character(1)), srcref @@ -996,7 +1060,10 @@ err <- local({ format_header_line_plain <- function(x, prefix = NULL) { p_error <- format_error_heading_plain(x, prefix) p_call <- format_call_plain(x[["call"]]) - p_srcref <- format_srcref_plain(conditionCall(x), x$procsrcref %||% x$srcref) + p_srcref <- format_srcref_plain( + conditionCall(x), + x$procsrcref %||% x$srcref + ) paste0(p_error, p_call, p_srcref, if (!is.null(conditionCall(x))) ":") } @@ -1039,7 +1106,9 @@ err <- local({ format_trace_call_plain <- function(call) { fmc <- trimws(format(call)[1]) - if (length(fmc) > 1) { fmc <- paste0(fmc[1], " ...") } + if (length(fmc) > 1) { + fmc <- paste0(fmc[1], " ...") + } strtrim(fmc, getOption("width") - 5) } @@ -1097,7 +1166,9 @@ err <- local({ FALSE } else if (tolower(getOption("knitr.in.progress", "false")) == "true") { FALSE - } else if (tolower(getOption("rstudio.notebook.executing", "false")) == "true") { + } else if ( + tolower(getOption("rstudio.notebook.executing", "false")) == "true" + ) { FALSE } else if (identical(Sys.getenv("TESTTHAT"), "true")) { FALSE @@ -1112,13 +1183,14 @@ err <- local({ rstudio_stdout <- function() { rstudio <- rstudio_detect() - rstudio$type %in% c( - "rstudio_console", - "rstudio_console_starting", - "rstudio_build_pane", - "rstudio_job", - "rstudio_render_pane" - ) + rstudio$type %in% + c( + "rstudio_console", + "rstudio_console_starting", + "rstudio_build_pane", + "rstudio_job", + "rstudio_render_pane" + ) } default_output <- function() { @@ -1136,7 +1208,12 @@ err <- local({ registerS3method("format", "rlib_trace_3_0", format_trace, baseenv()) registerS3method("print", "rlib_error_3_0", print_error, baseenv()) registerS3method("print", "rlib_trace_3_0", print_trace, baseenv()) - registerS3method("conditionMessage", "rlib_error_3_0", cnd_message, baseenv()) + registerS3method( + "conditionMessage", + "rlib_error_3_0", + cnd_message, + baseenv() + ) } } @@ -1164,39 +1241,40 @@ err <- local({ structure( list( - .internal = err_env, - new_cond = new_cond, - new_error = new_error, - throw = throw, - throw_error = throw_error, - chain_error = chain_error, - chain_call = chain_call, + .internal = err_env, + new_cond = new_cond, + new_error = new_error, + throw = throw, + throw_error = throw_error, + chain_error = chain_error, + chain_call = chain_call, chain_clean_call = chain_clean_call, - add_trace_back = add_trace_back, - process_call = process_call, - onload_hook = onload_hook, - is_interactive = is_interactive, + add_trace_back = add_trace_back, + process_call = process_call, + onload_hook = onload_hook, + is_interactive = is_interactive, format = list( - advice = format_advice, - call = format_call, - class = format_class, - error = format_error, + advice = format_advice, + call = format_call, + class = format_class, + error = format_error, error_heading = format_error_heading, - header_line = format_header_line, - srcref = format_srcref, - trace = format_trace + header_line = format_header_line, + srcref = format_srcref, + trace = format_trace ) ), - class = c("standalone_errors", "standalone")) + class = c("standalone_errors", "standalone") + ) }) # These are optional, and feel free to remove them if you prefer to # call them through the `err` object. -new_cond <- err$new_cond -new_error <- err$new_error -throw <- err$throw -throw_error <- err$throw_error -chain_error <- err$chain_error -chain_call <- err$chain_call +new_cond <- err$new_cond +new_error <- err$new_error +throw <- err$throw +throw_error <- err$throw_error +chain_error <- err$chain_error +chain_call <- err$chain_call chain_clean_call <- err$chain_clean_call diff --git a/R/format-conditions.R b/R/format-conditions.R index 772f40d5..1cebaddb 100644 --- a/R/format-conditions.R +++ b/R/format-conditions.R @@ -1,4 +1,3 @@ - #' Format an error, warning or diagnostic message #' #' You can then throw this message with [stop()] or `rlang::abort()`. @@ -32,8 +31,10 @@ #' @export format_error <- function(message, .envir = parent.frame()) { - if (length(message) > 0 && - (is.null(names(message)) || names(message)[1] == "")) { + if ( + length(message) > 0 && + (is.null(names(message)) || names(message)[1] == "") + ) { # The default theme will make this bold names(message)[1] <- "1" } @@ -46,15 +47,19 @@ format_error <- function(message, .envir = parent.frame()) { oldopt <- options( cli.width = getOption("cli.condition_width") %||% getOption("cli.width") ) - on.exit(options(oldopt), add =TRUE) + on.exit(options(oldopt), add = TRUE) # We need to create a frame here, so cli_div() is closed. # Cannot use local(), it does not work in snapshot tests, it potentially # has issues elsewhere as well. - formatted1 <- cli_fmt((function() { - cli_div(class = "cli_rlang cli_abort", theme = cnd_theme()) - cli_bullets(message, .envir = .envir) - })(), collapse = TRUE, strip_newline = TRUE) + formatted1 <- cli_fmt( + (function() { + cli_div(class = "cli_rlang cli_abort", theme = cnd_theme()) + cli_bullets(message, .envir = .envir) + })(), + collapse = TRUE, + strip_newline = TRUE + ) # remove "Error: " that was only needed for the wrapping formatted1[1] <- sub("Error:[ ]?", "", formatted1[1]) @@ -66,8 +71,10 @@ format_error <- function(message, .envir = parent.frame()) { #' @export format_warning <- function(message, .envir = parent.frame()) { - if (length(message) > 0 && - (is.null(names(message)) || names(message)[1] == "")) { + if ( + length(message) > 0 && + (is.null(names(message)) || names(message)[1] == "") + ) { # The default theme will make this bold names(message)[1] <- "1" } @@ -77,10 +84,14 @@ format_warning <- function(message, .envir = parent.frame()) { ) on.exit(options(oldopt), add = TRUE) - formatted1 <- cli_fmt((function() { - cli_div(class = "cli_rlang cli_warn", theme = cnd_theme()) - cli_bullets(message, .envir = .envir) - })(), collapse = TRUE, strip_newline = TRUE) + formatted1 <- cli_fmt( + (function() { + cli_div(class = "cli_rlang cli_warn", theme = cnd_theme()) + cli_bullets(message, .envir = .envir) + })(), + collapse = TRUE, + strip_newline = TRUE + ) update_rstudio_color(formatted1) } @@ -93,10 +104,14 @@ format_message <- function(message, .envir = parent.frame()) { cli.width = getOption("cli.condition_width") %||% getOption("cli.width") ) on.exit(options(oldopt), add = TRUE) - formatted1 <- cli_fmt((function() { - cli_div(class = "cli_rlang cli_inform", theme = cnd_theme()) - cli_bullets(message, .envir = .envir) - })(), collapse = TRUE, strip_newline = TRUE) + formatted1 <- cli_fmt( + (function() { + cli_div(class = "cli_rlang cli_inform", theme = cnd_theme()) + cli_bullets(message, .envir = .envir) + })(), + collapse = TRUE, + strip_newline = TRUE + ) update_rstudio_color(formatted1) } @@ -122,13 +137,13 @@ get_rstudio_fg_color <- function() { get_rstudio_fg_color0 <- function() { rs <- rstudio_detect() oktypes <- c("rstudio_console", "rstudio_console_starting") - if (! rs$type %in% oktypes) return(NULL) + if (!rs$type %in% oktypes) return(NULL) if (rs$num_colors == 1) return(NULL) colstr <- get_rstudio_theme()$foreground if (is.null(colstr)) return(NULL) colstr0 <- substr(colstr, 5, nchar(colstr) - 1) rgbnum <- scan(text = colstr0, sep = ",", quiet = TRUE) - rgb <- grDevices::rgb(rgbnum[1]/255, rgbnum[2]/255, rgbnum[3]/255) + rgb <- grDevices::rgb(rgbnum[1] / 255, rgbnum[2] / 255, rgbnum[3] / 255) make_ansi_style(rgb) } diff --git a/R/format.R b/R/format.R index 10d377bf..ccc2c35a 100644 --- a/R/format.R +++ b/R/format.R @@ -1,4 +1,3 @@ - #' Format a value for printing #' #' This function can be used directly, or via the `{.val ...}` inline diff --git a/R/friendly-type.R b/R/friendly-type.R index 2333e11c..9f16d2ee 100644 --- a/R/friendly-type.R +++ b/R/friendly-type.R @@ -1,186 +1,184 @@ - # This is based on rlang:::obj_type_friendly, but adapted to cli friendly_type <- local({ + friendly_type <- function(x, value = TRUE, length = FALSE) { + if (is_missing(x)) { + return("absent") + } -friendly_type <- function(x, value = TRUE, length = FALSE) { - if (is_missing(x)) { - return("absent") - } - - if (is.object(x)) { - if (inherits(x, "quosure")) { - return("a {.cls quosure} object") - } else if (identical(class(x), "data.frame")) { - return("a data frame") - } else if (identical(class(x), c("tbl_df", "tbl", "data.frame"))) { - return("a tibble") - } else { - # this is sometimes wrong for 'h', but ce la vie - fst <- tolower(substr(class(x)[1], 1, 1)) - prop <- if (fst %in% c("a", "e", "i", "o", "u")) { - "an" + if (is.object(x)) { + if (inherits(x, "quosure")) { + return("a {.cls quosure} object") + } else if (identical(class(x), "data.frame")) { + return("a data frame") + } else if (identical(class(x), c("tbl_df", "tbl", "data.frame"))) { + return("a tibble") } else { - "a" + # this is sometimes wrong for 'h', but ce la vie + fst <- tolower(substr(class(x)[1], 1, 1)) + prop <- if (fst %in% c("a", "e", "i", "o", "u")) { + "an" + } else { + "a" + } + return(paste0(prop, " {.cls {class(x)[1]}} object")) } - return(paste0(prop, " {.cls {class(x)[1]}} object")) } - } - - if (!is_vector(x)) { - return(as_friendly_type(typeof(x))) - } - n_dim <- length(dim(x)) - - if (value && !n_dim) { - if (is_na(x)) { - return(switch( - typeof(x), - logical = "{.code NA}", - integer = "an integer {.code NA}", - double = "a numeric {.code NA}", - complex = "a complex {.code NA}", - character = "a character {.code NA}", - typeof(x) - )) + if (!is_vector(x)) { + return(as_friendly_type(typeof(x))) } - if (length(x) == 1 && !is_list(x)) { - return(switch( - typeof(x), - logical = if (x) "{.code TRUE}" else "{.code FALSE}", - integer = "an integer", - double = "a number", - complex = "a complex number", - character = if (nzchar(x)) "a string" else "{.code \"\"}", - raw = "a raw value", - sprintf("a %s value", typeof(x)) - )) - } - if (length(x) == 0) { - return(switch( - typeof(x), - logical = "an empty logical vector", - integer = "an empty integer vector", - double = "an empty numeric vector", - complex = "an empty complex vector", - character = "an empty character vector", - raw = "an empty raw vector", - list = "an empty list", - sprintf("a %s of length one", typeof(x)) - )) + + n_dim <- length(dim(x)) + + if (value && !n_dim) { + if (is_na(x)) { + return(switch( + typeof(x), + logical = "{.code NA}", + integer = "an integer {.code NA}", + double = "a numeric {.code NA}", + complex = "a complex {.code NA}", + character = "a character {.code NA}", + typeof(x) + )) + } + if (length(x) == 1 && !is_list(x)) { + return(switch( + typeof(x), + logical = if (x) "{.code TRUE}" else "{.code FALSE}", + integer = "an integer", + double = "a number", + complex = "a complex number", + character = if (nzchar(x)) "a string" else "{.code \"\"}", + raw = "a raw value", + sprintf("a %s value", typeof(x)) + )) + } + if (length(x) == 0) { + return(switch( + typeof(x), + logical = "an empty logical vector", + integer = "an empty integer vector", + double = "an empty numeric vector", + complex = "an empty complex vector", + character = "an empty character vector", + raw = "an empty raw vector", + list = "an empty list", + sprintf("a %s of length one", typeof(x)) + )) + } } - } - type <- friendly_vector_type(typeof(x), n_dim) + type <- friendly_vector_type(typeof(x), n_dim) + + if (length && !n_dim) { + type <- paste0(type, sprintf(" of length %s", length(x))) + } - if (length && !n_dim) { - type <- paste0(type, sprintf(" of length %s", length(x))) + type } - type -} + friendly_vector_type <- function(type, n_dim) { + if (type == "list") { + if (n_dim < 2) { + return("a list") + } else if (n_dim == 2) { + return("a list matrix") + } else { + return("a list array") + } + } + + type <- switch( + type, + logical = "a logical %s", + integer = "an integer %s", + numeric = , + double = "a double %s", + complex = "a complex %s", + character = "a character %s", + raw = "a raw %s", + type = paste0("a ", type, " %s") + ) -friendly_vector_type <- function(type, n_dim) { - if (type == "list") { if (n_dim < 2) { - return("a list") + kind <- "vector" } else if (n_dim == 2) { - return("a list matrix") + kind <- "matrix" } else { - return("a list array") + kind <- "array" } + sprintf(type, kind) } - type <- switch( - type, - logical = "a logical %s", - integer = "an integer %s", - numeric = , - double = "a double %s", - complex = "a complex %s", - character = "a character %s", - raw = "a raw %s", - type = paste0("a ", type, " %s") - ) - - if (n_dim < 2) { - kind <- "vector" - } else if (n_dim == 2) { - kind <- "matrix" - } else { - kind <- "array" + as_friendly_type <- function(type) { + switch( + type, + + list = "a list", + + NULL = "NULL", + environment = "an environment", + externalptr = "a pointer", + weakref = "a weak reference", + S4 = "an S4 object", + + name = , + symbol = "a symbol", + language = "a call", + pairlist = "a pairlist node", + expression = "an expression vector", + + char = "an internal string", + promise = "an internal promise", + ... = "an internal dots object", + any = "an internal {.code any} object", + bytecode = "an internal bytecode object", + + primitive = , + builtin = , + special = "a primitive function", + closure = "a function", + + type + ) } - sprintf(type, kind) -} - -as_friendly_type <- function(type) { - switch( - type, - - list = "a list", - - NULL = "NULL", - environment = "an environment", - externalptr = "a pointer", - weakref = "a weak reference", - S4 = "an S4 object", - - name = , - symbol = "a symbol", - language = "a call", - pairlist = "a pairlist node", - expression = "an expression vector", - - char = "an internal string", - promise = "an internal promise", - ... = "an internal dots object", - any = "an internal {.code any} object", - bytecode = "an internal bytecode object", - - primitive = , - builtin = , - special = "a primitive function", - closure = "a function", - type - ) -} - -is_missing <- function(x) { - missing(x) || identical(x, quote(expr = )) -} - -is_vector <- function(x) { - t <- typeof(x) - t %in% c( - "logical", - "integer", - "double", - "complex", - "character", - "raw", - "list" - ) -} + is_missing <- function(x) { + missing(x) || identical(x, quote(expr = )) + } -is_scalar_vector <- function(x) { - is_vector(x) && length(x) == 1L -} + is_vector <- function(x) { + t <- typeof(x) + t %in% + c( + "logical", + "integer", + "double", + "complex", + "character", + "raw", + "list" + ) + } -is_na <- function(x) { - is_scalar_vector(x) && is.na(x) -} + is_scalar_vector <- function(x) { + is_vector(x) && length(x) == 1L + } -is_list <- function(x) { - typeof(x) == "list" -} + is_na <- function(x) { + is_scalar_vector(x) && is.na(x) + } -list( - .internal = environment(), - friendly_type = friendly_type -) + is_list <- function(x) { + typeof(x) == "list" + } + list( + .internal = environment(), + friendly_type = friendly_type + ) }) typename <- friendly_type$friendly_type diff --git a/R/glue.R b/R/glue.R index b8f08572..94d3b579 100644 --- a/R/glue.R +++ b/R/glue.R @@ -1,4 +1,3 @@ - # Compared to glue::glue(), these are fixed: # - .sep = "" # - .trim = TRUE @@ -9,10 +8,15 @@ # we also don't allow passing in data as arguments, and `text` is # a single argument, no need to `paste()` etc. -glue <- function(text, .envir = parent.frame(), - .transformer = identity_transformer, - .open = "{", .close = "}", .cli = FALSE, .trim = TRUE) { - +glue <- function( + text, + .envir = parent.frame(), + .transformer = identity_transformer, + .open = "{", + .close = "}", + .cli = FALSE, + .trim = TRUE +) { text <- paste0(text, collapse = "") if (length(text) < 1L) { @@ -113,22 +117,33 @@ drop_null <- function(x) { #' # head style #' ansi_collapse(letters, trunc = 5, style = "head") -ansi_collapse <- function(x, sep = ", ", sep2 = sub("^,", "", last), last = ", and ", - trunc = Inf, width = Inf, ellipsis = symbol$ellipsis, - style = c("both-ends", "head")) { - +ansi_collapse <- function( + x, + sep = ", ", + sep2 = sub("^,", "", last), + last = ", and ", + trunc = Inf, + width = Inf, + ellipsis = symbol$ellipsis, + style = c("both-ends", "head") +) { style <- match.arg(style) switch( style, "both-ends" = collapse_both_ends( - x, sep, sep2, last, trunc, width, ellipsis + x, + sep, + sep2, + last, + trunc, + width, + ellipsis ), "head" = collapse_head(x, sep, sep2, last, trunc, width, ellipsis) ) } collapse_head_notrim <- function(x, trunc, sep, sep2, last, ellipsis) { - lnx <- length(x) if (lnx == 1L) return(x) @@ -151,7 +166,6 @@ collapse_head_notrim <- function(x, trunc, sep, sep2, last, ellipsis) { } collapse_head <- function(x, sep, sep2, last, trunc, width, ellipsis) { - trunc <- max(trunc, 1L) x <- as.character(x) lnx <- length(x) @@ -174,19 +188,19 @@ collapse_head <- function(x, sep, sep2, last, trunc, width, ellipsis) { if (tcd) x <- x[1:trunc] # then we calculate the width w/o trimming - wx <- ansi_nchar(x) - wsep <- ansi_nchar(sep, "width") + wx <- ansi_nchar(x) + wsep <- ansi_nchar(sep, "width") wsep2 <- ansi_nchar(sep2, "width") wlast <- ansi_nchar(last, "width") - well <- ansi_nchar(ellipsis, "width") + well <- ansi_nchar(ellipsis, "width") if (!tcd) { # x[1] # x[1] and x[2] # x[1], x[2], and x[3] - nsep <- if (lnx > 2L) lnx - 2L else 0L + nsep <- if (lnx > 2L) lnx - 2L else 0L nsep2 <- if (lnx == 2L) 1L else 0L nlast <- if (lnx > 2L) 1L else 0L - wtot <- sum(wx) + nsep * wsep + nsep2 * wsep2 + nlast * wlast + wtot <- sum(wx) + nsep * wsep + nsep2 * wsep2 + nlast * wlast if (wtot <= width) { if (lnx == 1L) { return(x) @@ -200,7 +214,6 @@ collapse_head <- function(x, sep, sep2, last, trunc, width, ellipsis) { )) } } - } else { # x[1], x[2], x[trunc], ... wtot <- sum(wx) + trunc * wsep + well @@ -244,7 +257,6 @@ collapse_head <- function(x, sep, sep2, last, trunc, width, ellipsis) { } collapse_both_ends <- function(x, sep, sep2, last, trunc, width, ellipsis) { - if (width != Inf) { warning(format_warning(c( "!" = "finite {.arg width} is not implemented in {.fun cli::ansi_collapse}.", diff --git a/R/hash.R b/R/hash.R index 21427702..64c804b4 100644 --- a/R/hash.R +++ b/R/hash.R @@ -1,4 +1,3 @@ - #' SHA-256 hash #' #' Calculate the SHA-256 hash of each element of a character vector. @@ -305,10 +304,10 @@ hash_emoji1_transform <- function(md5, size) { hash <- sum(mdint * 16^(0:12)) base <- nrow(emojis) - ehash <- hash %% (base ** size) + ehash <- hash %% (base**size) digits <- integer() while (ehash > 0) { - digits <- c(digits, ehash %% base) + digits <- c(digits, ehash %% base) ehash <- ehash %/% base } digits <- c(digits, rep(0, 10))[1:size] @@ -449,7 +448,7 @@ hash_animal1_transform <- function(md5, n_adj) { len_ani <- length(gfycat_animals) len_adj <- length(gfycat_adjectives) - ehash <- hash %% (len_adj ** n_adj * len_ani) + ehash <- hash %% (len_adj**n_adj * len_ani) digits <- ehash %% len_ani ehash <- ehash %/% len_ani diff --git a/R/inline.R b/R/inline.R index 2a28eb2d..9b643eca 100644 --- a/R/inline.R +++ b/R/inline.R @@ -1,8 +1,6 @@ - if (getRversion() >= "2.15.1") utils::globalVariables("app") inline_generic <- function(app, x, style) { - if (is.character(x) && any(grepl("\n", x))) { if (getOption("cli.warn_inline_newlines", FALSE)) { warning("cli replaced newlines within {. ... } with spaces") @@ -165,7 +163,6 @@ inline_transformer <- function(code, envir) { } out - } else { # plain substitution expr <- parse(text = code, keep.source = FALSE) @@ -203,8 +200,11 @@ inline_transformer <- function(code, envir) { } id <- clii__container_start( - app, "span", id = id, - class = paste(class, collapse = " "), theme = tid + app, + "span", + id = id, + class = paste(class, collapse = " "), + theme = tid ) # We don't need to end the replacement container, that happens upstream. if (node$tag != "span") { @@ -251,9 +251,19 @@ make_cmd_transformer <- function(values, .call = NULL) { # rxode2 has the other ones, and we should fix that in rxode2 # the function calls are in the oolong packagee, need to fix this as well. exceptions <- c( - ".x", ".y", ".", - ".md", ".met", ".med", ".mul", ".muR", ".dir", ".muU", - ".sym_flip(bool_word)", ".sym_flip(bool_topic)", ".sym_flip(bool_wsi)" + ".x", + ".y", + ".", + ".md", + ".met", + ".med", + ".mul", + ".muR", + ".dir", + ".muU", + ".sym_flip(bool_word)", + ".sym_flip(bool_topic)", + ".sym_flip(bool_wsi)" ) # it is not easy to do better than this, we would need to pass a call @@ -267,8 +277,8 @@ make_cmd_transformer <- function(values, .call = NULL) { if (first_char == "?") { parse_plural(code, values) - # {.} cli style - } else if (first_char == "." && ! code %in% exceptions) { + # {.} cli style + } else if (first_char == "." && !code %in% exceptions) { m <- regexpr(inline_regex(), code, perl = TRUE) has_match <- m != -1 if (!has_match) { @@ -276,11 +286,15 @@ make_cmd_transformer <- function(values, .call = NULL) { call. = caller, "Invalid cli literal: {.code {{{abbrev(code, 10)}}}} starts with a dot.", "i" = "Interpreted literals must not start with a dot in cli >= 3.4.0.", - "i" = paste("{.code {{}}} expressions starting with a dot are", - "now only used for cli styles."), - "i" = paste("To avoid this error, put a space character after", - "the starting {.code {'{'}} or use parentheses:", - "{.code {{({abbrev(code, 10)})}}}.") + "i" = paste( + "{.code {{}}} expressions starting with a dot are", + "now only used for cli styles." + ), + "i" = paste( + "To avoid this error, put a space character after", + "the starting {.code {'{'}} or use parentheses:", + "{.code {{({abbrev(code, 10)})}}}." + ) )) } @@ -298,7 +312,7 @@ make_cmd_transformer <- function(values, .call = NULL) { ) paste0("<", values$marker, ".", funname, " ", out, values$marker, ">") - # {} plain substitution + # {} plain substitution } else { expr <- parse(text = code, keep.source = FALSE) %??% cli_error( @@ -341,7 +355,7 @@ glue_cmd <- function(..., .envir, .call = sys.call(-1), .trim = TRUE) { glue_no_cmd <- function(...) { str <- paste0(unlist(list(...), use.names = FALSE), collapse = "") - values <-new.env(parent = emptyenv()) + values <- new.env(parent = emptyenv()) glue_delay( str = str, values = values diff --git a/R/internals.R b/R/internals.R index 2436645c..d4bf3a3d 100644 --- a/R/internals.R +++ b/R/internals.R @@ -1,9 +1,16 @@ - call_if_fun <- function(x) { if (is.function(x)) x() else x } -clii__xtext <- function(app, text, .list, indent, padding, ln = TRUE, wrap = TRUE) { +clii__xtext <- function( + app, + text, + .list, + indent, + padding, + ln = TRUE, + wrap = TRUE +) { style <- app$get_current_style() text <- app$inline(text, .list = .list) exdent <- style$`text-exdent` %||% 0L @@ -39,7 +46,12 @@ clii__get_width <- function(app, extra) { } clii__cat <- function(app, lines) { - clii__message(lines, appendLF = FALSE, output = app$output, signal = app$signal) + clii__message( + lines, + appendLF = FALSE, + output = app$output, + signal = app$signal + ) } clii__cat_ln <- function(app, lines, indent, padding) { @@ -57,7 +69,7 @@ clii__cat_ln <- function(app, lines, indent, padding) { ## indent or negative indent if (length(lines)) { if (indent < 0) { - lines[1] <- dedent(lines[1], - indent) + lines[1] <- dedent(lines[1], -indent) } else if (indent > 0) { lines[1] <- paste0(strrep(" ", indent), lines[1]) } @@ -79,7 +91,12 @@ clii__vspace <- function(app, n) { sp <- strrep("\n", n - app$margin) signal <- !identical(app$signal, FALSE) if (signal && length(app$status_bar)) clii__clear_status_bar(app) - clii__message(sp, appendLF = FALSE, output = app$output, signal = app$signal) + clii__message( + sp, + appendLF = FALSE, + output = app$output, + signal = app$signal + ) app$margin <- n if (signal && length(app$status_bar)) { app$cat(paste0(app$status_bar[[1]]$content, "\r")) @@ -88,7 +105,7 @@ clii__vspace <- function(app, n) { } get_real_output <- function(output) { - if (! inherits(output, "connection")) { + if (!inherits(output, "connection")) { output <- switch( output, "auto" = cli_output_connection(), @@ -100,9 +117,13 @@ get_real_output <- function(output) { output } -clii__message <- function(..., domain = NA, appendLF = TRUE, - output = stderr(), signal = TRUE) { - +clii__message <- function( + ..., + domain = NA, + appendLF = TRUE, + output = stderr(), + signal = TRUE +) { msg <- .makeMessage(..., domain = domain, appendLF = appendLF) output <- get_real_output(output) @@ -111,7 +132,6 @@ clii__message <- function(..., domain = NA, appendLF = TRUE, if (identical(signal, FALSE)) { safe_cat0(msg, file = output) - } else { withRestarts(muffleMessage = function() NULL, { cond <- simpleMessage(msg) diff --git a/R/keypress.R b/R/keypress.R index bc0a4e2b..f585b19d 100644 --- a/R/keypress.R +++ b/R/keypress.R @@ -1,4 +1,3 @@ - #' Read a single keypress at the terminal #' #' It currently only works at Linux/Unix and OSX terminals, @@ -65,12 +64,11 @@ has_keypress_support <- function() { if (rs$type != "not_rstudio") { rs$has_canonical_mode - } else { isatty(stdin()) && Sys.getenv("R_GUI_APP_VERSION") == "" && .Platform$GUI != "Rgui" && - ! identical(getOption("STERM"), "iESS") && + !identical(getOption("STERM"), "iESS") && Sys.getenv("EMACS") != "t" && Sys.getenv("TERM") != "dumb" } diff --git a/R/lorem.R b/R/lorem.R index 2cad07fa..93c8a47f 100644 --- a/R/lorem.R +++ b/R/lorem.R @@ -1,4 +1,3 @@ - lorem_words <- c( "ad", "adipisicing", @@ -64,8 +63,11 @@ lorem_words <- c( "voluptate" ) -lorem_ipsum <- function(paragraphs = 1, par_sentence_range = 5:10, - sentence_word_range = 5:15) { +lorem_ipsum <- function( + paragraphs = 1, + par_sentence_range = 5:10, + sentence_word_range = 5:15 +) { vcapply( 1:paragraphs, function(x, ...) lorem_paragraph(...), diff --git a/R/num-ansi-colors.R b/R/num-ansi-colors.R index 716eb04e..acebc8ef 100644 --- a/R/num-ansi-colors.R +++ b/R/num-ansi-colors.R @@ -1,4 +1,3 @@ - #' Detect the number of ANSI colors to use #' #' @description @@ -145,9 +144,11 @@ num_ansi_colors <- function(stream = "auto") { # Windows Emacs? The top R process will have `--ess` in ESS, but the # subprocesses won't. (Without ESS subprocesses will also report 8L # colors, this is a problem, but we expect most people use ESS in Emacs.) - if (os_type() == "windows" && + if ( + os_type() == "windows" && "--ess" %in% commandArgs() && - is_emacs_with_color()) { + is_emacs_with_color() + ) { default <- get_default_number_of_colors() return(default %||% 8L) } @@ -172,7 +173,6 @@ num_ansi_colors <- function(stream = "auto") { #' The terminal color detection algorithm: detect_tty_colors <- function() { - default <- get_default_number_of_colors() #' 1. If the `COLORTERM` environment variable is set to `truecolor` or @@ -201,8 +201,11 @@ detect_tty_colors <- function() { #' can be used to override this. win10 <- win10_build() - if (os_type() == "windows" && win10 >= 10586 && - rstudio_detect()$type == "rstudio_terminal") { + if ( + os_type() == "windows" && + win10 >= 10586 && + rstudio_detect()$type == "rstudio_terminal" + ) { # this is rather weird, but echo turns on color support :D system2("cmd", c("/c", "echo 1 >NUL")) return(default %||% 8L) @@ -225,13 +228,14 @@ detect_tty_colors <- function() { } if (os_type() == "windows") { - #' 1. If we are on Windows, under ConEmu or cmder, or ANSICON is loaded, #' then the value of `cli.default_num_colors`, or 8L if unset, is #' returned. - if (Sys.getenv("ConEmuANSI") == "ON" || - Sys.getenv("CMDER_ROOT") != "") { + if ( + Sys.getenv("ConEmuANSI") == "ON" || + Sys.getenv("CMDER_ROOT") != "" + ) { return(default %||% 8L) } if (Sys.getenv("ANSICON") != "") return(default %||% 8L) @@ -251,7 +255,9 @@ detect_tty_colors <- function() { if (inherits(cols, "try-error") || !length(cols) || is.na(cols)) { return(guess_tty_colors()) } - if (cols %in% c(-1, 0, 1)) { return(1) } + if (cols %in% c(-1, 0, 1)) { + return(1) + } #' If the `TERM` environment variable is `xterm` and `tput` #' returned 8L, we return 256L, because xterm compatible terminals @@ -286,14 +292,16 @@ get_default_number_of_colors <- function() { guess_tty_colors <- function() { term <- Sys.getenv("TERM") - if (term == "dumb") return (1L) - - if (grepl( - "^screen|^xterm|^vt100|color|ansi|cygwin|linux", - term, - ignore.case = TRUE, - perl = TRUE - )) { + if (term == "dumb") return(1L) + + if ( + grepl( + "^screen|^xterm|^vt100|color|ansi|cygwin|linux", + term, + ignore.case = TRUE, + perl = TRUE + ) + ) { 8L } else { 1L @@ -302,7 +310,8 @@ guess_tty_colors <- function() { is_emacs_with_color <- function() { (Sys.getenv("EMACS") != "" || Sys.getenv("INSIDE_EMACS") != "") && - ! is.na(emacs_version()[1]) && emacs_version()[1] >= 23 + !is.na(emacs_version()[1]) && + emacs_version()[1] >= 23 } emacs_version <- function() { diff --git a/R/numbers.R b/R/numbers.R index 67d020fd..e6a11909 100644 --- a/R/numbers.R +++ b/R/numbers.R @@ -1,8 +1,5 @@ - format_num <- local({ - pretty_num <- function(number, style = c("default", "nopad", "6")) { - style <- switch( match.arg(style), "default" = pretty_num_default, @@ -14,7 +11,25 @@ format_num <- local({ } compute_num <- function(number, smallest_prefix = "y") { - prefixes0 <- c("y","z","a","f","p","n","u","m","", "k", "M", "G", "T", "P", "E", "Z", "Y") + prefixes0 <- c( + "y", + "z", + "a", + "f", + "p", + "n", + "u", + "m", + "", + "k", + "M", + "G", + "T", + "P", + "E", + "Z", + "Y" + ) zeroshif0 <- 9L stopifnot( @@ -25,7 +40,7 @@ format_num <- local({ smallest_prefix %in% prefixes0 ) - limits <- c(999950 * 1000 ^ (seq_len(length(prefixes0)) - (zeroshif0 + 1L))) + limits <- c(999950 * 1000^(seq_len(length(prefixes0)) - (zeroshif0 + 1L))) nrow <- length(limits) low <- match(smallest_prefix, prefixes0) zeroshift <- zeroshif0 + 1L - low @@ -40,15 +55,19 @@ format_num <- local({ nrow = nrow, ncol = length(number) ) - mat2 <- matrix(mat < limits, nrow = nrow, ncol = length(number)) + mat2 <- matrix(mat < limits, nrow = nrow, ncol = length(number)) exponent <- nrow - colSums(mat2) - (zeroshift - 1L) in_range <- function(exponent) { - max(min(exponent, nrow - zeroshift, na.rm = FALSE), 1L - zeroshift, na.rm = TRUE) + max( + min(exponent, nrow - zeroshift, na.rm = FALSE), + 1L - zeroshift, + na.rm = TRUE + ) } if (length(exponent)) { exponent <- sapply(exponent, in_range) } - res <- number / 1000 ^ exponent + res <- number / 1000^exponent prefix <- prefixes[exponent + zeroshift] ## Zero number @@ -94,13 +113,13 @@ format_num <- local({ amt <- round(szs$amount, 2) sep <- " " - na <- is.na(amt) - nan <- is.nan(amt) - neg <- !na & !nan & szs$negative - l10p <- !na & !nan & !neg & amt < 10 + na <- is.na(amt) + nan <- is.nan(amt) + neg <- !na & !nan & szs$negative + l10p <- !na & !nan & !neg & amt < 10 l100p <- !na & !nan & !neg & amt >= 10 & amt < 100 b100p <- !na & !nan & !neg & amt >= 100 - l10n <- !na & !nan & neg & amt < 10 + l10n <- !na & !nan & neg & amt < 10 l100n <- !na & !nan & neg & amt >= 10 & amt < 100 b100n <- !na & !nan & neg & amt >= 100 @@ -119,8 +138,8 @@ format_num <- local({ structure( list( - .internal = environment(), - pretty_num = pretty_num, + .internal = environment(), + pretty_num = pretty_num, compute_num = compute_num ), class = c("standalone_num", "standalone") diff --git a/R/onload.R b/R/onload.R index b0279943..2380a9ca 100644 --- a/R/onload.R +++ b/R/onload.R @@ -1,10 +1,10 @@ - #' @useDynLib cli, .registration=TRUE NULL ## nocov start -dummy <- function() { } +dummy <- function() { +} cli_timer_dynamic <- 200L cli_timer_non_dynamic <- 3000L @@ -27,14 +27,16 @@ clienv$unloaded <- FALSE rstudio_r_fix <- 0 .onLoad <- function(libname, pkgname) { - err$onload_hook() # Try to restore cursor as much as we can if (Sys.getenv("R_CLI_HIDE_CURSOR") != "false" && isatty(stdout())) { reg.finalizer(clienv, function(e) cli::ansi_show_cursor(), TRUE) task_callback <<- addTaskCallback( - function(...) { cli::ansi_show_cursor(); TRUE }, + function(...) { + cli::ansi_show_cursor() + TRUE + }, "cli-show-cursor" ) } @@ -69,7 +71,7 @@ rstudio_r_fix <- 0 reg.finalizer(asNamespace("cli"), function(x) x$unload(), TRUE) if (getRversion() >= "3.5.0") { - `__cli_update_due` <<- .Call(clic_make_timer); + `__cli_update_due` <<- .Call(clic_make_timer) } else { rm("__cli_update_due", envir = pkgenv) makeActiveBinding( @@ -85,7 +87,7 @@ rstudio_r_fix <- 0 "symbol", function() { ## If `cli.unicode` is set we use that - opt <- getOption("cli.unicode", NULL) + opt <- getOption("cli.unicode", NULL) if (!is.null(opt)) { if (isTRUE(opt)) { return(symbol_utf8) @@ -108,28 +110,28 @@ rstudio_r_fix <- 0 pkgenv ) - makeActiveBinding("pb_bar", cli__pb_bar, pkgenv) - makeActiveBinding("pb_current", cli__pb_current, pkgenv) - makeActiveBinding("pb_current_bytes", cli__pb_current_bytes, pkgenv) - makeActiveBinding("pb_elapsed", cli__pb_elapsed, pkgenv) - makeActiveBinding("pb_elapsed_clock", cli__pb_elapsed_clock, pkgenv) - makeActiveBinding("pb_elapsed_raw", cli__pb_elapsed_raw, pkgenv) - makeActiveBinding("pb_eta", cli__pb_eta, pkgenv) - makeActiveBinding("pb_eta_raw", cli__pb_eta_raw, pkgenv) - makeActiveBinding("pb_eta_str", cli__pb_eta_str, pkgenv) - makeActiveBinding("pb_extra", cli__pb_extra, pkgenv) - makeActiveBinding("pb_id", cli__pb_id, pkgenv) - makeActiveBinding("pb_name", cli__pb_name, pkgenv) - makeActiveBinding("pb_percent", cli__pb_percent, pkgenv) - makeActiveBinding("pb_pid", cli__pb_pid, pkgenv) - makeActiveBinding("pb_rate", cli__pb_rate, pkgenv) - makeActiveBinding("pb_rate_raw", cli__pb_rate_raw, pkgenv) - makeActiveBinding("pb_rate_bytes", cli__pb_rate_bytes, pkgenv) - makeActiveBinding("pb_spin", cli__pb_spin, pkgenv) - makeActiveBinding("pb_status", cli__pb_status, pkgenv) - makeActiveBinding("pb_timestamp", cli__pb_timestamp, pkgenv) - makeActiveBinding("pb_total", cli__pb_total, pkgenv) - makeActiveBinding("pb_total_bytes", cli__pb_total_bytes, pkgenv) + makeActiveBinding("pb_bar", cli__pb_bar, pkgenv) + makeActiveBinding("pb_current", cli__pb_current, pkgenv) + makeActiveBinding("pb_current_bytes", cli__pb_current_bytes, pkgenv) + makeActiveBinding("pb_elapsed", cli__pb_elapsed, pkgenv) + makeActiveBinding("pb_elapsed_clock", cli__pb_elapsed_clock, pkgenv) + makeActiveBinding("pb_elapsed_raw", cli__pb_elapsed_raw, pkgenv) + makeActiveBinding("pb_eta", cli__pb_eta, pkgenv) + makeActiveBinding("pb_eta_raw", cli__pb_eta_raw, pkgenv) + makeActiveBinding("pb_eta_str", cli__pb_eta_str, pkgenv) + makeActiveBinding("pb_extra", cli__pb_extra, pkgenv) + makeActiveBinding("pb_id", cli__pb_id, pkgenv) + makeActiveBinding("pb_name", cli__pb_name, pkgenv) + makeActiveBinding("pb_percent", cli__pb_percent, pkgenv) + makeActiveBinding("pb_pid", cli__pb_pid, pkgenv) + makeActiveBinding("pb_rate", cli__pb_rate, pkgenv) + makeActiveBinding("pb_rate_raw", cli__pb_rate_raw, pkgenv) + makeActiveBinding("pb_rate_bytes", cli__pb_rate_bytes, pkgenv) + makeActiveBinding("pb_spin", cli__pb_spin, pkgenv) + makeActiveBinding("pb_status", cli__pb_status, pkgenv) + makeActiveBinding("pb_timestamp", cli__pb_timestamp, pkgenv) + makeActiveBinding("pb_total", cli__pb_total, pkgenv) + makeActiveBinding("pb_total_bytes", cli__pb_total_bytes, pkgenv) if (is.null(getOption("callr.condition_handler_cli_message"))) { options(callr.condition_handler_cli_message = cli__default_handler) diff --git a/R/pluralize.R b/R/pluralize.R index 68b82f08..c7663fc6 100644 --- a/R/pluralize.R +++ b/R/pluralize.R @@ -1,4 +1,3 @@ - #' About cli pluralization #' #' @name pluralization @@ -10,10 +9,7 @@ make_quantity <- function(object) { val <- if (is.numeric(object)) { stopifnot(length(object) == 1) - if (is.finite(object)) - as.integer(object) - else - object + if (is.finite(object)) as.integer(object) else object } else { length(object) } @@ -93,10 +89,7 @@ process_plural <- function(qty, code) { if (length(parts) == 1) { if (is.finite(qty) & qty == 1) "" else parts[1] } else if (length(parts) == 2) { - if (is.finite(qty) & qty == 1) - parts[1] - else - parts[2] + if (is.finite(qty) & qty == 1) parts[1] else parts[2] } else if (length(parts) == 3) { if (is.finite(qty) & qty == 0) { parts[1] @@ -176,9 +169,11 @@ post_process_plurals <- function(str, values) { #' nupd <- 3; ntotal <- 10 #' cli_text("{nupd}/{ntotal} {qty(nupd)} file{?s} {?needs/need} updates") -pluralize <- function(..., .envir = parent.frame(), - .transformer = glue::identity_transformer) { - +pluralize <- function( + ..., + .envir = parent.frame(), + .transformer = glue::identity_transformer +) { values <- new.env(parent = emptyenv()) values$empty <- random_id() values$qty <- values$empty @@ -196,7 +191,6 @@ pluralize <- function(..., .envir = parent.frame(), } else { return(process_plural(make_quantity(values$qty), text)) } - } else { values$num_subst <- values$num_subst + 1 qty <- .transformer(text, envir) diff --git a/R/prettycode.R b/R/prettycode.R index 8e306209..a61355b3 100644 --- a/R/prettycode.R +++ b/R/prettycode.R @@ -1,15 +1,46 @@ - operator_tokens <- function() { c( - "'-'", "'+'", "'!'", "'~'", "'?'", "':'", "'*'", "'/'", "'^'", - "SPECIAL", "LT", "GT", "EQ", "GE", "LE", "AND", "AND2", "OR", "OR2", - "LEFT_ASSIGN", "RIGHT_ASSIGN", "'$'", "'@'", "EQ_ASSIGN", "PIPE" + "'-'", + "'+'", + "'!'", + "'~'", + "'?'", + "':'", + "'*'", + "'/'", + "'^'", + "SPECIAL", + "LT", + "GT", + "EQ", + "GE", + "LE", + "AND", + "AND2", + "OR", + "OR2", + "LEFT_ASSIGN", + "RIGHT_ASSIGN", + "'$'", + "'@'", + "EQ_ASSIGN", + "PIPE" ) } reserved_words <- function() { - c("FUNCTION", "'\\\\'", "IF", "ELSE", - "REPEAT", "WHILE", "FOR", "IN", "NEXT", "BREAK") + c( + "FUNCTION", + "'\\\\'", + "IF", + "ELSE", + "REPEAT", + "WHILE", + "FOR", + "IN", + "NEXT", + "BREAK" + ) } @@ -37,7 +68,6 @@ reserved_words <- function() { #' cat(code_highlight(deparse(ls)), sep = "\n") code_highlight <- function(code, code_theme = NULL, envir = NULL) { - code_theme <- code_theme %||% code_theme_default() parsed <- tryCatch( @@ -105,7 +135,11 @@ code_highlight <- function(code, code_theme = NULL, envir = NULL) { raw <- substr(data$text[string], 1, 1) == "r" hitext[string][raw] <- paste0( rep(reserved("r"), sum(raw)), - theme$string(substr(data$text[string][raw], 2, nchar(data$text[string][raw]))) + theme$string(substr( + data$text[string][raw], + 2, + nchar(data$text[string][raw]) + )) ) hitext[string][!raw] <- theme$string(data$text[string][!raw]) } @@ -130,7 +164,7 @@ get_parse_data <- function(x) { data <- getParseData(x, includeText = FALSE) data$text <- character(nrow(data)) - substr_with_tabs <- function (x, start, stop, tabsize = 8) { + substr_with_tabs <- function(x, start, stop, tabsize = 8) { widths <- rep_len(1, nchar(x)) tabs <- which(strsplit(x, "")[[1]] == "\t") for (i in tabs) { @@ -166,12 +200,11 @@ get_parse_data <- function(x) { } do_subst <- function(code, pdata, hitext) { - pdata$hitext <- hitext ## Need to do this line by line. TODO: multiline stuff might be broken vapply(seq_along(code), FUN.VALUE = character(1), function(no) { - my <- pdata[pdata$line1 == no & pdata$line2 == no,, drop = FALSE] + my <- pdata[pdata$line1 == no & pdata$line2 == no, , drop = FALSE] replace_in_place(code[no], my$col1, my$col2, my$hitext) }) } @@ -180,7 +213,7 @@ open_brackets <- function() { c("(", "{", "[") } -close_brackets <- function(){ +close_brackets <- function() { c(")", "}", "]") } @@ -189,7 +222,7 @@ bracket_tokens <- function() { c(paste0("'", s, "'"), "LBB") } -apply_color <- function(x, lvl, l){ +apply_color <- function(x, lvl, l) { k <- (lvl - 1) %% length(l) + 1 l[[k]](x) } @@ -226,14 +259,16 @@ apply_color <- function(x, lvl, l){ #' #' @noRd -color_brackets <- function(x, color_seq = list(col_yellow, col_blue, col_cyan)) { +color_brackets <- function( + x, + color_seq = list(col_yellow, col_blue, col_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 @@ -253,7 +288,6 @@ color_brackets <- function(x, color_seq = list(col_yellow, col_blue, col_cyan)) } replace_in_place <- function(str, start, end, replacement) { - stopifnot( length(str) == 1, length(start) == length(end), @@ -302,7 +336,7 @@ code_theme_make <- function(theme) { if (is_string(theme)) { if (theme %in% names(rstudio_themes)) return(rstudio_themes[[theme]]) lcs <- gsub(" ", "_", tolower(names(rstudio_themes)), fixed = TRUE) - if (theme %in% lcs) return(rstudio_themes[[ match(theme, lcs)[1] ]]) + if (theme %in% lcs) return(rstudio_themes[[match(theme, lcs)[1]]]) warning("Unknown cli code theme: `", theme, "`.") return(NULL) } @@ -312,10 +346,12 @@ code_theme_make <- function(theme) { code_theme_default_rstudio <- function() { theme <- get_rstudio_theme()$editor - if (! theme %in% names(rstudio_themes)) { + if (!theme %in% names(rstudio_themes)) { if (!getOption("cli.ignore_unknown_rstudio_theme", FALSE)) { warning( - "cli does not know this RStudio theme: '", theme, "'.", + "cli does not know this RStudio theme: '", + theme, + "'.", "\nSet `options(cli.ignore_unknown_rstudio_theme = TRUE)` ", "to suppress this warning" ) @@ -379,7 +415,7 @@ pretty_print_function <- function(x, useSource = TRUE, code_theme = NULL, ...) { if (num_ansi_colors() == 1L) return(base::print.function(x, useSource)) srcref <- getSrcref(x) - src <- if (useSource && ! is.null(srcref)) { + src <- if (useSource && !is.null(srcref)) { as.character(srcref) } else { deparse(x) @@ -388,7 +424,8 @@ pretty_print_function <- function(x, useSource = TRUE, code_theme = NULL, ...) { err <- FALSE hisrc <- tryCatch( code_highlight(src, code_theme = code_theme, envir = environment(x)), - error = function(e) err <<- TRUE) + error = function(e) err <<- TRUE + ) if (err) return(base::print.function(x, useSource)) ## Environment of the function @@ -409,7 +446,12 @@ pretty_print_function <- function(x, useSource = TRUE, code_theme = NULL, ...) { #' @export pretty_print_code <- function() { - registerS3method("print", "function", pretty_print_function, asNamespace("cli")) + registerS3method( + "print", + "function", + pretty_print_function, + asNamespace("cli") + ) cli::cli_alert_success("Registered pretty printing function method") } @@ -417,7 +459,7 @@ pretty_fun_link <- function(data, fun_call, envir) { sprt <- ansi_hyperlink_types()$help wch <- which(fun_call) txt <- data$text[wch] - if (! sprt || length(wch) == 0) return(txt) + if (!sprt || length(wch) == 0) return(txt) scheme <- if (identical(attr(sprt, "type"), "rstudio")) { "ide:help" @@ -429,8 +471,11 @@ pretty_fun_link <- function(data, fun_call, envir) { prt <- data$parent[idx] sgs <- which(data$parent == prt) # not a pkg::fun call? - if (length(sgs) != 3 || data$token[sgs[1]] != "SYMBOL_PACKAGE" || - data$token[sgs[2]] != "NS_GET") { + if ( + length(sgs) != 3 || + data$token[sgs[1]] != "SYMBOL_PACKAGE" || + data$token[sgs[2]] != "NS_GET" + ) { # note: we do not process ::: which would be NS_GET_INT find_function_symbol(data$text[idx], envir %||% .GlobalEnv) } else { diff --git a/R/print.R b/R/print.R index cefedb89..8c8dca2d 100644 --- a/R/print.R +++ b/R/print.R @@ -1,4 +1,3 @@ - #' Create a format method for an object using cli tools #' #' This method can be typically used in `format()` S3 methods. Then the @@ -58,7 +57,6 @@ #' options(opt) # <- restore theme cli_format_method <- function(expr, theme = getOption("cli.theme")) { - # This is not needed for cli, but needed for sink() and crayon nc <- num_ansi_colors() opts <- options( diff --git a/R/progress-along.R b/R/progress-along.R index ec4d6b65..caf9bbcf 100644 --- a/R/progress-along.R +++ b/R/progress-along.R @@ -1,4 +1,3 @@ - #' Add a progress bar to a mapping function or for loop #' #' @description @@ -97,17 +96,26 @@ #' @family functions supporting inline markup #' @export -cli_progress_along <- function(x, - name = NULL, - total = length(x), - ..., - .envir = parent.frame()) { - - name; total; .envir; list(...) +cli_progress_along <- function( + x, + name = NULL, + total = length(x), + ..., + .envir = parent.frame() +) { + name + total + .envir + list(...) if (getRversion() < "3.5.0") return(seq_along(x)) - id <- cli_progress_bar(name = name, total = total, ..., - .auto_close = FALSE, .envir = .envir) + id <- cli_progress_bar( + name = name, + total = total, + ..., + .auto_close = FALSE, + .envir = .envir + ) closeenv <- sys.frame(-1) if (format(closeenv) != clienv$globalenv) { defer( @@ -121,36 +129,42 @@ cli_progress_along <- function(x, } progress_altrep_update <- function(pb) { - tryCatch({ - cli_tick_reset() - caller <- pb$caller - pb$tick <- pb$tick + 1L + tryCatch( + { + cli_tick_reset() + caller <- pb$caller + pb$tick <- pb$tick + 1L - if (is.null(pb$format)) { - pb$format <- pb__default_format(pb$type, pb$total) - } + if (is.null(pb$format)) { + pb$format <- pb__default_format(pb$type, pb$total) + } - opt <- options(cli__pb = pb) - on.exit(options(opt), add = TRUE) + opt <- options(cli__pb = pb) + on.exit(options(opt), add = TRUE) - handlers <- cli_progress_select_handlers(pb, caller) - if (is.null(pb$added)) { - pb$added <- TRUE - for (h in handlers) { - if ("add" %in% names(h)) h$add(pb, .envir = caller) + handlers <- cli_progress_select_handlers(pb, caller) + if (is.null(pb$added)) { + pb$added <- TRUE + for (h in handlers) { + if ("add" %in% names(h)) h$add(pb, .envir = caller) + } + } else { + for (h in handlers) { + if ("set" %in% names(h)) h$set(pb, .envir = caller) + } } - } else { - for (h in handlers) { - if ("set" %in% names(h)) h$set(pb, .envir = caller) + }, + error = function(err) { + if (!isTRUE(pb$warned)) { + warning( + "cli progress bar update failed: ", + conditionMessage(err), + immediate. = TRUE + ) } + pb$warned <- TRUE } - }, error = function(err) { - if (!isTRUE(pb$warned)) { - warning("cli progress bar update failed: ", conditionMessage(err), - immediate. = TRUE) - } - pb$warned <- TRUE - }) + ) NULL } diff --git a/R/progress-bar.R b/R/progress-bar.R index fdad17af..b7cbefe3 100644 --- a/R/progress-bar.R +++ b/R/progress-bar.R @@ -1,4 +1,3 @@ - make_progress_bar <- function(percent, width = 30, style = list()) { complete_len <- round(width * percent) @@ -19,16 +18,22 @@ default_progress_style <- function() { opu <- progress_style(getOption("cli.progress_bar_style_unicode")) list( complete = opu$complete %||% opt$complete %||% "\u25A0", - current = opu$current %||% opt$current %||% opu$complete %||% - opt$complete %||% "\u25A0", + current = opu$current %||% + opt$current %||% + opu$complete %||% + opt$complete %||% + "\u25A0", incomplete = opu$incomplete %||% opt$incomplete %||% "\u00a0" ) } else { opa <- progress_style(getOption("cli.progress_bar_style_ascii")) list( complete = opa$complete %||% opt$complete %||% "=", - current = opa$current %||% opt$current %||% opa$complete %||% - opt$complete %||% ">", + current = opa$current %||% + opt$current %||% + opa$complete %||% + opt$complete %||% + ">", incomplete = opa$incomplete %||% opt$incomplete %||% "-" ) } diff --git a/R/progress-c.R b/R/progress-c.R index 09b42dcf..16d2909f 100644 --- a/R/progress-c.R +++ b/R/progress-c.R @@ -1,4 +1,3 @@ - progress_c_update <- function(pb, auto_done = TRUE) { cli_tick_reset() @@ -10,8 +9,9 @@ progress_c_update <- function(pb, auto_done = TRUE) { pb$format <- pb__default_format(pb$type, pb$total) } - if (pb$auto_terminate && auto_done && !is.na(pb$total) && - pb$current == pb$total) { + if ( + pb$auto_terminate && auto_done && !is.na(pb$total) && pb$current == pb$total + ) { progress_c_done(pb, caller = caller) return(NULL) } diff --git a/R/progress-client.R b/R/progress-client.R index 6e654139..660f3943 100644 --- a/R/progress-client.R +++ b/R/progress-client.R @@ -1,4 +1,3 @@ - #' cli progress bars #' #' @description @@ -302,21 +301,21 @@ #' @aliases __cli_update_due cli_tick_reset ccli_tick_reset ticking #' @export -cli_progress_bar <- function(name = NULL, - status = NULL, - type = c("iterator", "tasks", "download", - "custom"), - total = NA, - format = NULL, - format_done = NULL, - format_failed = NULL, - clear = getOption("cli.progress_clear", TRUE), - current = TRUE, - auto_terminate = type != "download", - extra = NULL, - .auto_close = TRUE, - .envir = parent.frame()) { - +cli_progress_bar <- function( + name = NULL, + status = NULL, + type = c("iterator", "tasks", "download", "custom"), + total = NA, + format = NULL, + format_done = NULL, + format_failed = NULL, + clear = getOption("cli.progress_clear", TRUE), + current = TRUE, + auto_terminate = type != "download", + extra = NULL, + .auto_close = TRUE, + .envir = parent.frame() +) { start <- .Call(clic_get_time) id <- new_uuid() envkey <- format(.envir) @@ -352,7 +351,11 @@ cli_progress_bar <- function(name = NULL, clienv$progress[[id]] <- bar if (current) { if (!is.null(clienv$progress_ids[[envkey]])) { - cli_progress_done(clienv$progress_ids[[envkey]], .envir = .envir, result = "done") + cli_progress_done( + clienv$progress_ids[[envkey]], + .envir = .envir, + result = "done" + ) } clienv$progress_ids[[envkey]] <- id } @@ -396,11 +399,16 @@ cli_progress_bar <- function(name = NULL, #' @name cli_progress_bar #' @export -cli_progress_update <- function(inc = NULL, set = NULL, total = NULL, - status = NULL, extra = NULL, - id = NULL, force = FALSE, - .envir = parent.frame()) { - +cli_progress_update <- function( + inc = NULL, + set = NULL, + total = NULL, + status = NULL, + extra = NULL, + id = NULL, + force = FALSE, + .envir = parent.frame() +) { id <- id %||% clienv$progress_ids[[format(.envir)]] if (is.null(id)) { envkey <- format(.envir) @@ -421,8 +429,10 @@ cli_progress_update <- function(inc = NULL, set = NULL, total = NULL, } if (!is.null(total)) { - if (is.na(pb$total) != is.na(total) || - (!is.na(total) && pb$total != total)) { + if ( + is.na(pb$total) != is.na(total) || + (!is.na(total) && pb$total != total) + ) { pb$total <- total if (!is.null(pb$format) && is.null(pb$format_orig)) { pb$format <- pb__default_format(pb$type, pb$total) @@ -439,8 +449,14 @@ cli_progress_update <- function(inc = NULL, set = NULL, total = NULL, now <- .Call(clic_get_time) upd <- .Call(clic_update_due) - if (force || (upd && now > pb$show_after) || - (!is.na(pb$total) && upd && now > pb$show_50 && pb$current <= pb$total / 2)) { + if ( + force || + (upd && now > pb$show_after) || + (!is.na(pb$total) && + upd && + now > pb$show_50 && + pb$current <= pb$total / 2) + ) { if (upd) cli_tick_reset() pb$tick <- pb$tick + 1L @@ -481,8 +497,11 @@ cli_progress_update <- function(inc = NULL, set = NULL, total = NULL, #' @name cli_progress_bar #' @export -cli_progress_done <- function(id = NULL, .envir = parent.frame(), - result = "done") { +cli_progress_done <- function( + id = NULL, + .envir = parent.frame(), + result = "done" +) { envkey <- format(.envir) id <- id %||% clienv$progress_ids[[envkey]] if (is.null(id)) return(invisible(TRUE)) @@ -626,12 +645,13 @@ cli_progress_output <- function(text, id = NULL, .envir = parent.frame()) { #' @family functions supporting inline markup #' @export -cli_progress_message <- function(msg, - current = TRUE, - .auto_close = TRUE, - .envir = parent.frame(), - ...) { - +cli_progress_message <- function( + msg, + current = TRUE, + .auto_close = TRUE, + .envir = parent.frame(), + ... +) { id <- cli_progress_bar( type = "custom", format = msg, @@ -776,16 +796,17 @@ cli_progress_message <- function(msg, #' @family functions supporting inline markup #' @export -cli_progress_step <- function(msg, - msg_done = msg, - msg_failed = msg, - spinner = FALSE, - class = if (!spinner) ".alert-info", - current = TRUE, - .auto_close = TRUE, - .envir = parent.frame(), - ...) { - +cli_progress_step <- function( + msg, + msg_done = msg, + msg_failed = msg, + spinner = FALSE, + class = if (!spinner) ".alert-info", + current = TRUE, + .auto_close = TRUE, + .envir = parent.frame(), + ... +) { format <- paste0( if (!is.null(class)) paste0("{", class, " "), if (spinner) "{cli::pb_spin} ", @@ -835,7 +856,6 @@ pb__default_format <- function(type, total) { "{cli::pb_current} done ({cli::pb_rate}) | {cli::pb_elapsed}" ) } - } else if (type == "tasks") { if (!is.na(total)) { opt <- getOption("cli.progress_format_tasks") @@ -853,7 +873,6 @@ pb__default_format <- function(type, total) { "{cli::pb_current} done ({cli::pb_rate}) | {cli::pb_elapsed}" ) } - } else if (type == "download") { if (!is.na(total)) { opt <- getOption("cli.progress_format_download") diff --git a/R/progress-server.R b/R/progress-server.R index 2f2d8f50..4d731afa 100644 --- a/R/progress-server.R +++ b/R/progress-server.R @@ -1,4 +1,3 @@ - # ------------------------------------------------------------------------ #' cli progress handlers @@ -88,7 +87,10 @@ cli_progress_select_handlers <- function(bar, .envir) { if (!is.null(onl)) return(bin[onl]) hnd_imp <- bin[hnd] - hnd_able <- Filter(function(h) is.null(h$able) || h$able(bar, .envir), hnd_imp) + hnd_able <- Filter( + function(h) is.null(h$able) || h$able(bar, .envir), + hnd_imp + ) if (length(hnd_able) > 1) hnd_able <- hnd_able[1] c(hnd_able, bin[frc]) @@ -104,7 +106,7 @@ builtin_handler_cli <- list( msg_failed = bar$format_failed %||% bar$format, .auto_close = FALSE, .envir = .envir, - ) + ) bar$last_shown <- bar$current bar$justadded <- TRUE }, @@ -122,8 +124,10 @@ builtin_handler_cli <- list( if (isTRUE(bar$added)) { if (bar$clear) { # Show the full bar non-dynamic ttys - if (!is_dynamic_tty() && - !identical(bar$last_shown, bar$current)) { + if ( + !is_dynamic_tty() && + !identical(bar$last_shown, bar$current) + ) { cli_status_update(id = bar$cli_statusbar, bar$format, .envir = .envir) } cli_status_clear(bar$cli_statusbar, result = "clear", .envir = .envir) @@ -182,8 +186,19 @@ builtin_handler_progressr <- list( # ------------------------------------------------------------------------ logger_out <- function(bar, event) { - cat(sep = "", format_iso_8601(Sys.time()), " ", bar$id, " ", - bar$current, "/", bar$total, " ", event, "\n") + cat( + sep = "", + format_iso_8601(Sys.time()), + " ", + bar$id, + " ", + bar$current, + "/", + bar$total, + " ", + event, + "\n" + ) } builtin_handler_logger <- list( diff --git a/R/progress-ticking.R b/R/progress-ticking.R index 2c55572f..882879fa 100644 --- a/R/progress-ticking.R +++ b/R/progress-ticking.R @@ -1,4 +1,3 @@ - #' @export ticking <- function(cond, name = NULL, ..., .envir = parent.frame()) { diff --git a/R/progress-utils.R b/R/progress-utils.R index 478040e7..330cdc46 100644 --- a/R/progress-utils.R +++ b/R/progress-utils.R @@ -1,4 +1,3 @@ - #' @title Progress bar utility functions. #' @details `cli_progress_num()` returns the number of currently #' active progress bars. (These do not currently include the progress diff --git a/R/progress-variables.R b/R/progress-variables.R index a8155770..e31d210c 100644 --- a/R/progress-variables.R +++ b/R/progress-variables.R @@ -1,4 +1,3 @@ - # ------------------------------------------------------------------------ #' @title Progress bar variables @@ -687,18 +686,19 @@ var_helper2 <- function(expr, clear = TRUE, delay = 0, ...) { # TODO: examples -cli_progress_demo <- function(name = NULL, status = NULL, - type = c("iterator", "tasks", - "download", "custom"), - total = NA, - .envir = parent.frame(), - ..., - at = if (is_interactive()) NULL else 50, - show_after = 0, - live = NULL, - delay = 0, - start = as.difftime(5, units = "secs")) { - +cli_progress_demo <- function( + name = NULL, + status = NULL, + type = c("iterator", "tasks", "download", "custom"), + total = NA, + .envir = parent.frame(), + ..., + at = if (is_interactive()) NULL else 50, + show_after = 0, + live = NULL, + delay = 0, + start = as.difftime(5, units = "secs") +) { opt <- options(cli.progress_show_after = show_after) on.exit(options(opt), add = TRUE) @@ -731,21 +731,24 @@ cli_progress_demo <- function(name = NULL, status = NULL, on.exit(close(output), add = TRUE) size <- 0L - withCallingHandlers({ - for (crnt in at) { - cli_progress_update(set = crnt, id = id, force = TRUE, .envir = .envir) - if (delay > 0) Sys.sleep(delay) + withCallingHandlers( + { + for (crnt in at) { + cli_progress_update(set = crnt, id = id, force = TRUE, .envir = .envir) + if (delay > 0) Sys.sleep(delay) + } + if (last) { + cli_progress_done(id = id, .envir = .envir) + } else { + suppressMessages(cli_progress_done(id = id, .envir = .envir)) + } + }, + cliMessage = function(msg) { + cat(file = output, msg$message) + size <<- size + nchar(msg$message, type = "bytes") + if (!live) invokeRestart("muffleMessage") } - if (last) { - cli_progress_done(id = id, .envir = .envir) - } else { - suppressMessages(cli_progress_done(id = id, .envir = .envir)) - } - }, cliMessage = function(msg) { - cat(file = output, msg$message) - size <<- size + nchar(msg$message, type = "bytes") - if (!live) invokeRestart("muffleMessage") - }) + ) lines <- readChar(output, size, useBytes = TRUE) lines <- sub_("^\r\r*", "", lines, useBytes = TRUE) diff --git a/R/rematch2.R b/R/rematch2.R index 4e280151..c9129f4d 100644 --- a/R/rematch2.R +++ b/R/rematch2.R @@ -1,29 +1,26 @@ - re_match <- function(text, pattern, perl = TRUE, ...) { - stopifnot(is.character(pattern), length(pattern) == 1, !is.na(pattern)) text <- as.character(text) match <- regexpr(pattern, text, perl = perl, ...) - start <- as.vector(match) + start <- as.vector(match) length <- attr(match, "match.length") - end <- start + length - 1L + end <- start + length - 1L matchstr <- substring(text, start, end) - matchstr[ start == -1 ] <- NA_character_ + matchstr[start == -1] <- NA_character_ empty <- data.frame(stringsAsFactors = FALSE, .text = text)[, numeric()] res <- list(match = !is.na(matchstr), groups = empty) if (!is.null(attr(match, "capture.start"))) { - - gstart <- attr(match, "capture.start") + gstart <- attr(match, "capture.start") glength <- attr(match, "capture.length") - gend <- gstart + glength - 1L + gend <- gstart + glength - 1L groupstr <- substring(text, gstart, gend) - groupstr[ gstart == -1 ] <- NA_character_ + groupstr[gstart == -1] <- NA_character_ dim(groupstr) <- dim(gstart) res$groups <- cbind(groupstr, res$groups, stringsAsFactors = FALSE) diff --git a/R/rlang.R b/R/rlang.R index ce6e79e5..41447e06 100644 --- a/R/rlang.R +++ b/R/rlang.R @@ -1,4 +1,3 @@ - #' Signal an error, warning or message with a cli formatted #' message #' @@ -36,11 +35,13 @@ #' @family functions supporting inline markup #' @export -cli_abort <- function(message, - ..., - call = .envir, - .envir = parent.frame(), - .frame = .envir) { +cli_abort <- function( + message, + ..., + call = .envir, + .envir = parent.frame(), + .frame = .envir +) { message[] <- vcapply(message, format_inline, .envir = .envir) rlang::abort( message, diff --git a/R/ruler.R b/R/ruler.R index 0e37cb46..e19537d9 100644 --- a/R/ruler.R +++ b/R/ruler.R @@ -1,4 +1,3 @@ - #' Print the helpful ruler to the screen #' #' @export diff --git a/R/rules.R b/R/rules.R index 1a665e37..2654bd9f 100644 --- a/R/rules.R +++ b/R/rules.R @@ -1,6 +1,4 @@ - make_line <- function(x, char = symbol$line, col = NULL) { - ## Easiest to handle this specially if (x <= 0) return("") @@ -118,10 +116,16 @@ make_line <- function(x, char = symbol$line, col = NULL) { #' #' @export -rule <- function(left = "", center = "", right = "", line = 1, - col = NULL, line_col = col, background_col = NULL, - width = console_width()) { - +rule <- function( + left = "", + center = "", + right = "", + line = 1, + col = NULL, + line_col = col, + background_col = NULL, + width = console_width() +) { try_silently(left <- as.character(left)) try_silently(center <- as.character(center)) try_silently(right <- as.character(right)) @@ -145,20 +149,21 @@ rule <- function(left = "", center = "", right = "", line = 1, res <- if (ansi_nchar(center)) { if (ansi_nchar(left) || ansi_nchar(right)) { - stop(sQuote("center"), " cannot be specified with ", sQuote("left"), - " or ", sQuote("right")) + stop( + sQuote("center"), + " cannot be specified with ", + sQuote("left"), + " or ", + sQuote("right") + ) } rule_center(options) - } else if (ansi_nchar(left) && ansi_nchar(right)) { rule_left_right(options) - } else if (ansi_nchar(left)) { rule_left(options) - } else if (ansi_nchar(right)) { rule_right(options) - } else { rule_line(options) } @@ -173,17 +178,16 @@ rule <- function(left = "", center = "", right = "", line = 1, get_line_char <- function(line) { if (identical(line, 1) || identical(line, 1L) || identical(line, "single")) { symbol$line - - } else if (identical(line, 2) || identical(line, 2L) || identical(line, "double")) { + } else if ( + identical(line, 2) || identical(line, 2L) || identical(line, "double") + ) { symbol$double_line - } else if (length(line) == 1 && line %in% paste0("bar", 1:8)) { bars <- structure( paste0("lower_block_", 1:8), names = paste0("bar", 1:8) ) - symbol[[ bars[[line]] ]] - + symbol[[bars[[line]]]] } else { paste(as.character(line), collapse = "") } @@ -194,7 +198,6 @@ rule_line <- function(o) { } rule_center <- function(o) { - o$center <- ansi_substring(o$center, 1, o$width - 4) o$center <- paste0(" ", o$center, " ") ncc <- ansi_nchar(o$center, "width") @@ -213,7 +216,9 @@ rule_left <- function(o) { paste0( make_line(2, get_line_char(o$line), o$line_col), - " ", o$left, " ", + " ", + o$left, + " ", make_line(o$width - ncl - 4, o$line, o$line_col) ) } @@ -223,24 +228,29 @@ rule_right <- function(o) { paste0( make_line(o$width - ncr - 4, o$line, o$line_col), - " ", o$right, " ", + " ", + o$right, + " ", make_line(2, o$line, o$line_col) ) } rule_left_right <- function(o) { - ncl <- ansi_nchar(o$left, "width") - ncr <- ansi_nchar(o$right, "width") + ncr <- ansi_nchar(o$right, "width") ## -- (ncl) -- (ncr) -- if (ncl + ncr + 10 > o$width) return(rule_left(o)) paste0( make_line(2, o$line, o$line_col), - " ", o$left, " ", + " ", + o$left, + " ", make_line(o$width - ncl - ncr - 8, o$line, o$line_col), - " ", o$right, " ", + " ", + o$right, + " ", make_line(2, o$line, o$line_col) ) } diff --git a/R/server.R b/R/server.R index 4409ef89..5b784780 100644 --- a/R/server.R +++ b/R/server.R @@ -1,4 +1,3 @@ - cli_server_default <- function(msg) { cli_server_default_safe(msg) } diff --git a/R/simple-theme.R b/R/simple-theme.R index 9928e209..c0e05d13 100644 --- a/R/simple-theme.R +++ b/R/simple-theme.R @@ -1,4 +1,3 @@ - #' A simple CLI theme #' #' To use this theme, you can set it as the `cli.theme` option. @@ -65,7 +64,6 @@ #' @export simple_theme <- function(dark = getOption("cli.theme_dark", "auto")) { - dark <- detect_dark_theme(dark) list( @@ -73,18 +71,22 @@ simple_theme <- function(dark = getOption("cli.theme_dark", "auto")) { "margin-top" = 1, "margin-bottom" = 0, color = "cyan", - fmt = function(x) cli::rule(x, line_col = "cyan")), + fmt = function(x) cli::rule(x, line_col = "cyan") + ), h2 = list( "margin-top" = 1, "margin-bottom" = 0, color = "cyan", - fmt = function(x) paste0(symbol$line, " ", x, " ", symbol$line, symbol$line)), + fmt = function(x) + paste0(symbol$line, " ", x, " ", symbol$line, symbol$line) + ), h3 = list( "margin-top" = 1, "margin-bottom" = 0, - color = "cyan"), + color = "cyan" + ), par = list("margin-top" = 0, "margin-bottom" = 1), @@ -108,11 +110,13 @@ simple_theme <- function(dark = getOption("cli.theme_dark", "auto")) { ), ".alert-start" = list( - before = function() paste0(symbol$arrow_right, " ")), + before = function() paste0(symbol$arrow_right, " ") + ), span.pkg = list( color = "blue", - "font-weight" = "bold"), + "font-weight" = "bold" + ), span.version = list(color = "blue"), span.emph = simple_theme_emph(), @@ -121,15 +125,21 @@ simple_theme <- function(dark = getOption("cli.theme_dark", "auto")) { span.fun = utils::modifyList(simple_theme_code(dark), list(after = "()")), span.fn = utils::modifyList(simple_theme_code(dark), list(after = "()")), span.arg = simple_theme_code(dark), - span.kbd = utils::modifyList(simple_theme_code(dark), - list(before = "<", after = ">")), - span.key = utils::modifyList(simple_theme_code(dark), - list(before = "<", after = ">")), + span.kbd = utils::modifyList( + simple_theme_code(dark), + list(before = "<", after = ">") + ), + span.key = utils::modifyList( + simple_theme_code(dark), + list(before = "<", after = ">") + ), span.file = simple_theme_file(), span.path = simple_theme_file(), span.email = simple_theme_url(), - span.url = utils::modifyList(simple_theme_url(), - list(before = "<", after = ">")), + span.url = utils::modifyList( + simple_theme_url(), + list(before = "<", after = ">") + ), span.var = simple_theme_code(dark), span.envvar = simple_theme_code(dark), @@ -148,7 +158,7 @@ simple_theme_url <- function() { simple_theme_code <- function(dark) { if (dark) { list("background-color" = "#232323", color = "#f0f0f0") - } else{ + } else { list("background-color" = "#f8f8f8", color = "#202020") } } @@ -180,7 +190,8 @@ is_iterm_dark <- function() { if (is.null(clienv[["is_iterm_dark"]])) { clienv$is_iterm_dark <- tryCatch( - error = function(x) FALSE, { + error = function(x) FALSE, + { osa <- ' tell application "iTerm2" tell current session of current window @@ -196,7 +207,8 @@ is_iterm_dark <- function() { )) nums <- scan(text = gsub(",", "", out, fixed = TRUE), quiet = TRUE) mean(nums) < 20000 - }) + } + ) } clienv[["is_iterm_dark"]] } diff --git a/R/sitrep.R b/R/sitrep.R index f092d692..86556b7e 100644 --- a/R/sitrep.R +++ b/R/sitrep.R @@ -1,4 +1,3 @@ - #' cli situation report #' #' Contains currently: @@ -28,8 +27,10 @@ cli_sitrep <- function() { console_utf8 = l10n_info()$`UTF-8`, latex_active = is_latex_output(), num_colors = num_ansi_colors(), - console_width = console_width()), - class = "cli_sitrep") + console_width = console_width() + ), + class = "cli_sitrep" + ) } #' @export @@ -51,7 +52,7 @@ get_active_symbol_set <- function() { format.cli_sitrep <- function(x, ...) { fmt_names <- format(names(x)) - fmt_vals <- vapply(x, format, character(1)) + fmt_vals <- vapply(x, format, character(1)) paste0("- ", fmt_names, " : ", fmt_vals) } diff --git a/R/sizes.R b/R/sizes.R index 1dacbc1f..9720c116 100644 --- a/R/sizes.R +++ b/R/sizes.R @@ -1,8 +1,5 @@ - format_bytes <- local({ - pretty_bytes <- function(bytes, style = c("default", "nopad", "6")) { - style <- switch( match.arg(style), "default" = pretty_bytes_default, @@ -24,7 +21,7 @@ format_bytes <- local({ smallest_unit %in% units0 ) - limits <- c(1000, 999950 * 1000 ^ (seq_len(length(units0) - 2) - 1)) + limits <- c(1000, 999950 * 1000^(seq_len(length(units0) - 2) - 1)) low <- match(smallest_unit, units0) units <- units0[low:length(units0)] limits <- limits[low:length(limits)] @@ -37,9 +34,9 @@ format_bytes <- local({ nrow = length(limits), ncol = length(bytes) ) - mat2 <- matrix(mat < limits, nrow = length(limits), ncol = length(bytes)) + mat2 <- matrix(mat < limits, nrow = length(limits), ncol = length(bytes)) exponent <- length(limits) - colSums(mat2) + low - 1L - res <- bytes / 1000 ^ exponent + res <- bytes / 1000^exponent unit <- units[exponent - low + 2L] ## Zero bytes @@ -49,7 +46,7 @@ format_bytes <- local({ ## NA and NaN bytes res[is.na(bytes)] <- NA_real_ res[is.nan(bytes)] <- NaN - unit[is.na(bytes)] <- units0[low] # Includes NaN as well + unit[is.na(bytes)] <- units0[low] # Includes NaN as well data.frame( stringsAsFactors = FALSE, @@ -83,10 +80,10 @@ format_bytes <- local({ szs <- compute_bytes(bytes, smallest_unit = "kB") amt <- szs$amount - na <- is.na(amt) - nan <- is.nan(amt) - neg <- !na & !nan & szs$negative - l10 <- !na & !nan & !neg & amt < 10 + na <- is.na(amt) + nan <- is.nan(amt) + neg <- !na & !nan & szs$negative + l10 <- !na & !nan & !neg & amt < 10 l100 <- !na & !nan & !neg & amt >= 10 & amt < 100 b100 <- !na & !nan & !neg & amt >= 100 @@ -105,8 +102,8 @@ format_bytes <- local({ structure( list( - .internal = environment(), - pretty_bytes = pretty_bytes, + .internal = environment(), + pretty_bytes = pretty_bytes, compute_bytes = compute_bytes ), class = c("standalone_bytes", "standalone") diff --git a/R/spark.R b/R/spark.R index 830203cc..bd37c8fc 100644 --- a/R/spark.R +++ b/R/spark.R @@ -1,4 +1,3 @@ - # from pillar #' Draw a sparkline bar graph with unicode block characters @@ -62,7 +61,6 @@ print.cli_spark <- function(x, ...) { } spark_bar_chars <- function(x, bars = NULL) { - if (is.null(bars)) { if (is_utf8_output()) { bars <- vapply(0x2581:0x2588, intToUtf8, character(1)) diff --git a/R/spinner.R b/R/spinner.R index 0ea17796..edbad74b 100644 --- a/R/spinner.R +++ b/R/spinner.R @@ -1,4 +1,3 @@ - ## See tools/spinners.R for how the RDS file is created #' Character vector to put a spinner on the screen @@ -57,7 +56,8 @@ get_spinner <- function(which = NULL) { which <- list( name = which, interval = spinners$interval[[row]], - frames = spinners$frames[[row]]) + frames = spinners$frames[[row]] + ) } if (!is.character(which$frames)) { @@ -164,13 +164,16 @@ list_spinners <- function() { #' @family spinners #' @export -make_spinner <- function(which = NULL, stream = "auto", template = "{spin}", - static = c("dots", "print", "print_line", - "silent")) { - +make_spinner <- function( + which = NULL, + stream = "auto", + template = "{spin}", + static = c("dots", "print", "print_line", "silent") +) { stopifnot( inherits(stream, "connection") || is_string(stream), - is_string(template)) + is_string(template) + ) c_stream <- get_real_output(stream) c_spinner <- get_spinner(which) @@ -211,8 +214,12 @@ make_spinner <- function(which = NULL, stream = "auto", template = "{spin}", c_res$spin <- function(template = NULL) { if (!is.null(template)) c_template <<- template if (throttle()) return() - line <- sub("{spin}", c_spinner$frames[[c_state]], c_template, - fixed = TRUE) + line <- sub( + "{spin}", + c_spinner$frames[[c_state]], + c_template, + fixed = TRUE + ) line_width <- ansi_nchar(line) if (is_ansi_tty(c_stream)) { cat("\r", line, ANSI_EL, sep = "", file = c_stream) @@ -230,7 +237,6 @@ make_spinner <- function(which = NULL, stream = "auto", template = "{spin}", c_width <<- line_width inc() } - } else { if (c_static == "dots") { c_res$spin <- function(template = NULL) { @@ -249,8 +255,12 @@ make_spinner <- function(which = NULL, stream = "auto", template = "{spin}", c_res$spin <- function(template = NULL) { if (!is.null(template)) c_template <<- template if (throttle()) return() - line <- sub("{spin}", c_spinner$frames[[c_state]], c_template, - fixed = TRUE) + line <- sub( + "{spin}", + c_spinner$frames[[c_state]], + c_template, + fixed = TRUE + ) cat(line, file = c_stream) inc() } @@ -258,8 +268,12 @@ make_spinner <- function(which = NULL, stream = "auto", template = "{spin}", c_res$spin <- function(template = NULL) { if (!is.null(template)) c_template <<- template if (throttle()) return() - line <- sub("{spin}", c_spinner$frames[[c_state]], c_template, - fixed = TRUE) + line <- sub( + "{spin}", + c_spinner$frames[[c_state]], + c_template, + fixed = TRUE + ) cat(line, "\n", sep = "", file = c_stream) inc() } @@ -342,7 +356,7 @@ demo_spinners_terminal <- function(ticks = 100 * 3000) { spin_width <- viapply(frames, function(x) max(nchar(x, type = "width"))) name_width <- nchar(names, type = "width") col_width <- spin_width + max(name_width) + 3 - col1_width <- max(col_width[1:(length(col_width)/2)]) + col1_width <- max(col_width[1:(length(col_width) / 2)]) frames <- mapply( frames, @@ -368,10 +382,9 @@ demo_spinners_terminal <- function(ticks = 100 * 3000) { cat(sp2, sep = "\n") up(length(sp2)) took <- Sys.time() - tic - togo <- as.difftime(1/1000, units = "secs") - took + togo <- as.difftime(1 / 1000, units = "secs") - took if (togo > 0) Sys.sleep(togo) } - } ## nocov end diff --git a/R/status-bar.R b/R/status-bar.R index 91701a40..df1aa0f2 100644 --- a/R/status-bar.R +++ b/R/status-bar.R @@ -1,4 +1,3 @@ - #' Update the status bar (superseded) #' #' @description @@ -50,12 +49,15 @@ #' @family functions supporting inline markup #' @export -cli_status <- function(msg, msg_done = paste(msg, "... done"), - msg_failed = paste(msg, "... failed"), - .keep = FALSE, .auto_close = TRUE, - .envir = parent.frame(), - .auto_result = c("clear", "done", "failed", "auto")) { - +cli_status <- function( + msg, + msg_done = paste(msg, "... done"), + msg_failed = paste(msg, "... failed"), + .keep = FALSE, + .auto_close = TRUE, + .envir = parent.frame(), + .auto_result = c("clear", "done", "failed", "auto") +) { id <- new_uuid() cli__message( "status", @@ -103,17 +105,21 @@ cli_status <- function(msg, msg_done = paste(msg, "... done"), #' functions, for a superior API. #' @export -cli_status_clear <- function(id = NULL, result = c("clear", "done", "failed"), - msg_done = NULL, msg_failed = NULL, - .envir = parent.frame()) { - +cli_status_clear <- function( + id = NULL, + result = c("clear", "done", "failed"), + msg_done = NULL, + msg_failed = NULL, + .envir = parent.frame() +) { cli__message( "status_clear", list( id = id %||% NA_character_, result = match.arg(result[1], c("clear", "done", "failed", "auto")), msg_done = if (!is.null(msg_done)) glue_cmd(msg_done, .envir = .envir), - msg_failed = if (!is.null(msg_failed)) glue_cmd(msg_failed, .envir = .envir) + msg_failed = if (!is.null(msg_failed)) + glue_cmd(msg_failed, .envir = .envir) ) ) } @@ -145,14 +151,20 @@ cli_status_clear <- function(id = NULL, result = c("clear", "done", "failed"), #' @family functions supporting inline markup #' @export -cli_status_update <- function(id = NULL, msg = NULL, msg_done = NULL, - msg_failed = NULL, .envir = parent.frame()) { +cli_status_update <- function( + id = NULL, + msg = NULL, + msg_done = NULL, + msg_failed = NULL, + .envir = parent.frame() +) { cli__message( "status_update", list( msg = if (!is.null(msg)) glue_cmd(msg, .envir = .envir), msg_done = if (!is.null(msg_done)) glue_cmd(msg_done, .envir = .envir), - msg_failed = if (!is.null(msg_failed)) glue_cmd(msg_failed, .envir = .envir), + msg_failed = if (!is.null(msg_failed)) + glue_cmd(msg_failed, .envir = .envir), id = id %||% NA_character_ ) ) @@ -224,14 +236,17 @@ cli_status_update <- function(id = NULL, msg = NULL, msg_done = NULL, #' } #' fun2() -cli_process_start <- function(msg, msg_done = paste(msg, "... done"), - msg_failed = paste(msg, "... failed"), - on_exit = c("auto", "failed", "done"), - msg_class = "alert-info", - done_class = "alert-success", - failed_class = "alert-danger", - .auto_close = TRUE, .envir = parent.frame()) { - +cli_process_start <- function( + msg, + msg_done = paste(msg, "... done"), + msg_failed = paste(msg, "... failed"), + on_exit = c("auto", "failed", "done"), + msg_class = "alert-info", + done_class = "alert-success", + failed_class = "alert-danger", + .auto_close = TRUE, + .envir = parent.frame() +) { # Force the defaults, because we might modify msg msg_done msg_failed @@ -246,8 +261,14 @@ cli_process_start <- function(msg, msg_done = paste(msg, "... done"), msg_failed <- paste0("{.", failed_class, " ", msg_failed, "}") } - cli_status(msg, msg_done, msg_failed, .auto_close = .auto_close, - .envir = .envir, .auto_result = match.arg(on_exit)) + cli_status( + msg, + msg_done, + msg_failed, + .auto_close = .auto_close, + .envir = .envir, + .auto_result = match.arg(on_exit) + ) } #' @param id Id of the status bar container to clear. If `id` is not the id @@ -258,10 +279,12 @@ cli_process_start <- function(msg, msg_done = paste(msg, "... done"), #' @rdname cli_process_start #' @export -cli_process_done <- function(id = NULL, msg_done = NULL, - .envir = parent.frame(), - done_class = "alert-success") { - +cli_process_done <- function( + id = NULL, + msg_done = NULL, + .envir = parent.frame(), + done_class = "alert-success" +) { if (!is.null(msg_done) && length(done_class) > 0 && done_class != "") { msg_done <- paste0("{.", done_class, " ", msg_done, "}") } @@ -271,11 +294,14 @@ cli_process_done <- function(id = NULL, msg_done = NULL, #' @rdname cli_process_start #' @export -cli_process_failed <- function(id = NULL, msg = NULL, msg_failed = NULL, - .envir = parent.frame(), - failed_class = "alert-danger") { - if (!is.null(msg_failed) && length(failed_class) > 0 && - failed_class != "") { +cli_process_failed <- function( + id = NULL, + msg = NULL, + msg_failed = NULL, + .envir = parent.frame(), + failed_class = "alert-danger" +) { + if (!is.null(msg_failed) && length(failed_class) > 0 && failed_class != "") { msg_failed <- paste0("{.", failed_class, " ", msg_failed, "}") } cli_status_clear( @@ -288,9 +314,16 @@ cli_process_failed <- function(id = NULL, msg = NULL, msg_failed = NULL, # ----------------------------------------------------------------------- -clii_status <- function(app, id, msg, msg_done, msg_failed, keep, - auto_result, globalenv) { - +clii_status <- function( + app, + id, + msg, + msg_done, + msg_failed, + keep, + auto_result, + globalenv +) { app$status_bar[[id]] <- list( content = "", msg_done = msg_done, @@ -310,7 +343,7 @@ clii_status_clear <- function(app, id, result, msg_done, msg_failed) { ## If no active status bar, then ignore if (is.null(id) || is.na(id)) return(invisible()) - if (! id %in% names(app$status_bar)) return(invisible()) + if (!id %in% names(app$status_bar)) return(invisible()) if (result == "auto") { r1 <- random_marker @@ -336,7 +369,6 @@ clii_status_clear <- function(app, id, result, msg_done, msg_failed) { if (app$status_bar[[id]]$keep) { ## Keep? Just emit it app$cat("\n") - } else { ## Not keep? Remove it clii__clear_status_bar(app) @@ -344,14 +376,12 @@ clii_status_clear <- function(app, id, result, msg_done, msg_failed) { if (isTRUE(getOption("cli.hide_cursor", TRUE))) { ansi_show_cursor(app$output) } - } else { if (app$status_bar[[id]]$keep) { ## Keep? clii__clear_status_bar(app) app$cat(paste0(app$status_bar[[id]]$content, "\n")) app$cat(paste0(app$status_bar[[1]]$content, "\r")) - } else { ## Not keep? Nothing to output } @@ -394,7 +424,8 @@ clii_status_update <- function(app, id, msg, msg_done, msg_failed) { app$status_bar[[id]]$content <- content app$status_bar <- c( app$status_bar[id], - app$status_bar[setdiff(names(app$status_bar), id)]) + app$status_bar[setdiff(names(app$status_bar), id)] + ) ## New content, if it is an ANSI terminal we'll overwrite and clear ## until the end of the line. Otherwise we add some space characters diff --git a/R/symbol.R b/R/symbol.R index a05b5e5b..b4236d2d 100644 --- a/R/symbol.R +++ b/R/symbol.R @@ -206,8 +206,9 @@ list_symbols <- function() { chars <- rpad(paste0(symbol, "\t", names(symbol)), 25) if (length(chars) %% 2) chars <- c(chars, "") chars <- paste( - sep = " ", - chars[1:(length(chars)/2)], - chars[(length(chars)/2 + 1):length(chars)]) + sep = " ", + chars[1:(length(chars) / 2)], + chars[(length(chars) / 2 + 1):length(chars)] + ) cat(chars, sep = "\n") } diff --git a/R/test.R b/R/test.R index 3f34c901..7cd2faf2 100644 --- a/R/test.R +++ b/R/test.R @@ -1,4 +1,3 @@ - #' Test cli output with testthat #' #' Use this function in your testthat test files, to test cli output. @@ -74,57 +73,68 @@ #' })) #' }) -test_that_cli <- function(desc, code, - configs = c("plain", "ansi", "unicode", "fancy"), - links = NULL) { +test_that_cli <- function( + desc, + code, + configs = c("plain", "ansi", "unicode", "fancy"), + links = NULL +) { code <- substitute(code) - configs <- apply(expand.grid(configs, links %||% ""), 1, paste, collapse = "-") + configs <- apply( + expand.grid(configs, links %||% ""), + 1, + paste, + collapse = "-" + ) configs <- sub("-$", "", configs) doconfigs <- list( - list(id = "plain", unicode = FALSE, num_colors = 1, links = FALSE), - list(id = "ansi", unicode = FALSE, num_colors = 256, links = FALSE), - list(id = "unicode", unicode = TRUE, num_colors = 1, links = FALSE), - list(id = "fancy", unicode = TRUE, num_colors = 256, links = FALSE), + list(id = "plain", unicode = FALSE, num_colors = 1, links = FALSE), + list(id = "ansi", unicode = FALSE, num_colors = 256, links = FALSE), + list(id = "unicode", unicode = TRUE, num_colors = 1, links = FALSE), + list(id = "fancy", unicode = TRUE, num_colors = 256, links = FALSE), - list(id = "plain-none", unicode = FALSE, num_colors = 1, links = FALSE), - list(id = "ansi-none", unicode = FALSE, num_colors = 256, links = FALSE), - list(id = "unicode-none", unicode = TRUE, num_colors = 1, links = FALSE), - list(id = "fancy-none", unicode = TRUE, num_colors = 256, links = FALSE), + list(id = "plain-none", unicode = FALSE, num_colors = 1, links = FALSE), + list(id = "ansi-none", unicode = FALSE, num_colors = 256, links = FALSE), + list(id = "unicode-none", unicode = TRUE, num_colors = 1, links = FALSE), + list(id = "fancy-none", unicode = TRUE, num_colors = 256, links = FALSE), - list(id = "plain-all", unicode = FALSE, num_colors = 1, links = TRUE), - list(id = "ansi-all", unicode = FALSE, num_colors = 256, links = TRUE), - list(id = "unicode-all", unicode = TRUE, num_colors = 1, links = TRUE), - list(id = "fancy-all", unicode = TRUE, num_colors = 256, links = TRUE) + list(id = "plain-all", unicode = FALSE, num_colors = 1, links = TRUE), + list(id = "ansi-all", unicode = FALSE, num_colors = 256, links = TRUE), + list(id = "unicode-all", unicode = TRUE, num_colors = 1, links = TRUE), + list(id = "fancy-all", unicode = TRUE, num_colors = 256, links = TRUE) ) parent <- parent.frame() lapply(doconfigs, function(conf) { - if (!is.null(configs) && ! conf$id %in% configs) return() - code2 <- substitute({ - testthat::local_reproducible_output( - crayon = num_colors > 1, - unicode = unicode - ) - withr::local_options( - cli.hyperlink = links, - cli.hyperlink_help = links, - cli.hyperlink_run = links, - cli.hyperlink_vignette = links, - cli.hyperlink_file_url_format = NULL, - cli.hyperlink_run_url_format = NULL, - cli.hyperlink_help_url_format = NULL, - cli.hyperlink_vignette_url_format = NULL - ) - withr::local_envvar( - R_CLI_HYPERLINK_FILE_URL_FORMAT = NA_character_, - R_CLI_HYPERLINK_RUN_URL_FORMAT = NA_character_, - R_CLI_HYPERLINK_HELP_URL_FORMAT = NA_character_, - R_CLI_HYPERLINK_VIGNETTE_URL_FORMAT = NA_character_ - ) - code_ - }, c(conf, list(code_ = code))) + if (!is.null(configs) && !conf$id %in% configs) return() + code2 <- substitute( + { + testthat::local_reproducible_output( + crayon = num_colors > 1, + unicode = unicode + ) + withr::local_options( + cli.hyperlink = links, + cli.hyperlink_help = links, + cli.hyperlink_run = links, + cli.hyperlink_vignette = links, + cli.hyperlink_file_url_format = NULL, + cli.hyperlink_run_url_format = NULL, + cli.hyperlink_help_url_format = NULL, + cli.hyperlink_vignette_url_format = NULL + ) + withr::local_envvar( + R_CLI_HYPERLINK_FILE_URL_FORMAT = NA_character_, + R_CLI_HYPERLINK_RUN_URL_FORMAT = NA_character_, + R_CLI_HYPERLINK_HELP_URL_FORMAT = NA_character_, + R_CLI_HYPERLINK_VIGNETTE_URL_FORMAT = NA_character_ + ) + code_ + }, + c(conf, list(code_ = code)) + ) desc2 <- paste0(desc, " [", conf$id, "]") test <- substitute( testthat::test_that(desc, code), diff --git a/R/themes.R b/R/themes.R index 826702ab..931b9c58 100644 --- a/R/themes.R +++ b/R/themes.R @@ -1,4 +1,3 @@ - #' List the currently active themes #' #' If there is no active app, then it calls [start_app()]. @@ -32,7 +31,7 @@ clii_add_theme <- function(app, theme) { } clii_remove_theme <- function(app, id) { - if (! id %in% names(app$themes)) return(invisible(FALSE)) + if (!id %in% names(app$themes)) return(invisible(FALSE)) app$themes[[id]] <- NULL invisible(TRUE) } @@ -88,7 +87,6 @@ clii_remove_theme <- function(app, id) { #' @export builtin_theme <- function(dark = getOption("cli.theme_dark", "auto")) { - dark <- detect_dark_theme(dark) list( @@ -103,16 +101,19 @@ builtin_theme <- function(dark = getOption("cli.theme_dark", "auto")) { "font-weight" = "bold", "margin-top" = 1, "margin-bottom" = 0, - fmt = function(x) cli::rule(x, line_col = "cyan")), + fmt = function(x) cli::rule(x, line_col = "cyan") + ), h2 = list( "font-weight" = "bold", "margin-top" = 1, "margin-bottom" = 1, - fmt = function(x) paste0(symbol$line, symbol$line, " ", x, " ", - symbol$line, symbol$line)), + fmt = function(x) + paste0(symbol$line, symbol$line, " ", x, " ", symbol$line, symbol$line) + ), h3 = list( "margin-top" = 1, - fmt = function(x) paste0(symbol$line, symbol$line, " ", x, " ")), + fmt = function(x) paste0(symbol$line, symbol$line, " ", x, " ") + ), ".alert" = list( before = function() paste0(symbol$arrow_right, " ") @@ -156,8 +157,7 @@ builtin_theme <- function(dark = getOption("cli.theme_dark", "auto")) { "text-exdent" = 2, before = function(x) paste0(symbol$arrow_right, " ") ), - ".bullets .bullet-1" = list( - ), + ".bullets .bullet-1" = list(), par = list("margin-top" = 0, "margin-bottom" = 1), ul = list( @@ -179,11 +179,15 @@ builtin_theme <- function(dark = getOption("cli.theme_dark", "auto")) { "ol ol li" = list("margin-left" = 2), "ol dl li" = list("margin-left" = 2), - blockquote = list("padding-left" = 4L, "padding-right" = 10L, - "font-style" = "italic", "margin-top" = 1L, - "margin-bottom" = 1L, - before = function() symbol$dquote_left, - after = function() symbol$dquote_right), + blockquote = list( + "padding-left" = 4L, + "padding-right" = 10L, + "font-style" = "italic", + "margin-top" = 1L, + "margin-bottom" = 1L, + before = function() symbol$dquote_left, + after = function() symbol$dquote_right + ), "blockquote cite" = list( before = function() paste0(symbol$em_dash, " "), "font-style" = "italic", @@ -197,7 +201,7 @@ builtin_theme <- function(dark = getOption("cli.theme_dark", "auto")) { span.strong = list("font-weight" = "bold"), span.code = theme_code_tick(dark), - span.q = list(fmt = quote_weird_name2), + span.q = list(fmt = quote_weird_name2), span.pkg = list(color = "blue"), span.fn = theme_function(dark), span.fun = theme_function(dark), @@ -212,8 +216,10 @@ builtin_theme <- function(dark = getOption("cli.theme_dark", "auto")) { fmt = quote_weird_name ), span.url = list( - before = "<", after = ">", - color = "blue", "font-style" = "italic", + before = "<", + after = ">", + color = "blue", + "font-style" = "italic", transform = function(x) make_link(x, type = "url") ), span.href = list( @@ -315,19 +321,22 @@ theme_progress_bar <- function(x, app, style) { } detect_dark_theme <- function(dark) { - tryCatch({ - if (dark == "auto") { - dark <- if (Sys.getenv("RSTUDIO", "0") == "1") { - get_rstudio_theme()$dark - } else if (is_iterm()) { - is_iterm_dark() - } else if (is_emacs()) { - Sys.getenv("ESS_BACKGROUND_MODE", "light") == "dark" - } else { - FALSE + tryCatch( + { + if (dark == "auto") { + dark <- if (Sys.getenv("RSTUDIO", "0") == "1") { + get_rstudio_theme()$dark + } else if (is_iterm()) { + is_iterm_dark() + } else if (is_emacs()) { + Sys.getenv("ESS_BACKGROUND_MODE", "light") == "dark" + } else { + FALSE + } } - } - }, error = function(e) FALSE) + }, + error = function(e) FALSE + ) isTRUE(dark) } @@ -409,8 +418,8 @@ create_formatter <- function(x) { is_color <- "color" %in% names(x) is_bg_color <- "background-color" %in% names(x) - if (!is_bold && !is_italic && !is_underline && !is_color - && !is_bg_color) return(x) + if (!is_bold && !is_italic && !is_underline && !is_color && !is_bg_color) + return(x) if (is_color && is.null(x[["color"]])) { x[["color"]] <- "none" @@ -457,13 +466,24 @@ merge_embedded_styles <- function(old, new) { prefix <- paste0(old$prefix, new$prefix) postfix <- paste0(new$postfix, old$postfix) - map <- utils::modifyList(old$`class-map` %||% list(), new$`class-map` %||% list()) + map <- utils::modifyList( + old$`class-map` %||% list(), + new$`class-map` %||% list() + ) start <- new$start %||% 1L mrg <- utils::modifyList(old, new) - mrg[c("margin-top", "margin-bottom", "margin-left", "margin-right", - "start", "class-map", "prefix", "postfix")] <- + mrg[c( + "margin-top", + "margin-bottom", + "margin-left", + "margin-right", + "start", + "class-map", + "prefix", + "postfix" + )] <- list(top, bottom, left, right, start, map, prefix, postfix) ## Formatter needs to be re-generated @@ -496,7 +516,6 @@ parse_selector <- function(x) { } parse_selector_node <- function(x) { - parse_ids <- function(y) { r <- strsplit(y, "#", fixed = TRUE)[[1]] if (length(r) > 1) r[-1] <- paste0("#", r[-1]) @@ -511,9 +530,11 @@ parse_selector_node <- function(x) { m_cls <- grepl("^\\.", parts) m_ids <- grepl("^#", parts) - list(tag = as.character(unique(parts[!m_cls & !m_ids])), - class = str_tail(unique(parts[m_cls])), - id = str_tail(unique(parts[m_ids]))) + list( + tag = as.character(unique(parts[!m_cls & !m_ids])), + class = str_tail(unique(parts[m_cls])), + id = str_tail(unique(parts[m_ids])) + ) } #' Match a selector node to a container @@ -560,7 +581,7 @@ match_selector <- function(sels, cnts) { # Last selector must match the last container if (sptr == 0 || sptr > cptr) return(FALSE) match <- match_selector_node(sels[[sptr]], cnts[[cptr]]) - if (!match) return (FALSE) + if (!match) return(FALSE) # Plus the rest should match somehow sptr <- sptr - 1L diff --git a/R/time-ago.R b/R/time-ago.R index 13bdf5c8..380b8bfd 100644 --- a/R/time-ago.R +++ b/R/time-ago.R @@ -1,6 +1,4 @@ - format_time_ago <- local({ - e <- expression `%s%` <- function(lhs, rhs) { @@ -25,35 +23,35 @@ format_time_ago <- local({ list(c = e(seconds < 90), s = "about a minute ago"), list(c = e(minutes < 45), s = e("%d minutes ago" %s% round(minutes))), list(c = e(minutes < 90), s = "about an hour ago"), - list(c = e(hours < 24), s = e("%d hours ago" %s% round(hours))), - list(c = e(hours < 42), s = "a day ago"), - list(c = e(days < 30), s = e("%d days ago" %s% round(days))), - list(c = e(days < 45), s = "about a month ago"), - list(c = e(days < 335), s = e("%d months ago" %s% round(days / 30))), - list(c = e(years < 1.5), s = "about a year ago"), - list(c = TRUE, s = e("%d years ago" %s% round(years))) + list(c = e(hours < 24), s = e("%d hours ago" %s% round(hours))), + list(c = e(hours < 42), s = "a day ago"), + list(c = e(days < 30), s = e("%d days ago" %s% round(days))), + list(c = e(days < 45), s = "about a month ago"), + list(c = e(days < 335), s = e("%d months ago" %s% round(days / 30))), + list(c = e(years < 1.5), s = "about a year ago"), + list(c = TRUE, s = e("%d years ago" %s% round(years))) ) vague_dt_short <- list( list(c = e(seconds < 50), s = "<1 min"), list(c = e(minutes < 50), s = e("%d min" %s% round(minutes))), - list(c = e(hours < 1.5), s = "1 hour"), - list(c = e(hours < 18), s = e("%d hours" %s% round(hours))), - list(c = e(hours < 42), s = "1 day"), - list(c = e(days < 30), s = e("%d day" %s% round(days))), - list(c = e(days < 45), s = "1 mon"), - list(c = e(days < 335), s = e("%d mon" %s% round(days / 30))), - list(c = e(years < 1.5), s = "1 year"), - list(c = TRUE, s = e("%d years" %s% round(years))) + list(c = e(hours < 1.5), s = "1 hour"), + list(c = e(hours < 18), s = e("%d hours" %s% round(hours))), + list(c = e(hours < 42), s = "1 day"), + list(c = e(days < 30), s = e("%d day" %s% round(days))), + list(c = e(days < 45), s = "1 mon"), + list(c = e(days < 335), s = e("%d mon" %s% round(days / 30))), + list(c = e(years < 1.5), s = "1 year"), + list(c = TRUE, s = e("%d years" %s% round(years))) ) vague_dt_terse <- list( list(c = e(seconds < 50), s = e("%2ds" %s% round(seconds))), list(c = e(minutes < 50), s = e("%2dm" %s% round(minutes))), - list(c = e(hours < 18), s = e("%2dh" %s% round(hours))), - list(c = e(days < 30), s = e("%2dd" %s% round(days))), - list(c = e(days < 335), s = e("%2dM" %s% round(days / 30))), - list(c = TRUE, s = e("%2dy" %s% round(years))) + list(c = e(hours < 18), s = e("%2dh" %s% round(hours))), + list(c = e(days < 30), s = e("%2dd" %s% round(days))), + list(c = e(days < 335), s = e("%2dM" %s% round(days / 30))), + list(c = TRUE, s = e("%2dy" %s% round(years))) ) vague_dt_formats <- list( @@ -63,7 +61,6 @@ format_time_ago <- local({ ) time_ago <- function(date, format = c("default", "short", "terse")) { - date <- as.POSIXct(date) if (length(date) > 1) return(sapply(date, time_ago, format = format)) @@ -74,7 +71,6 @@ format_time_ago <- local({ } vague_dt <- function(dt, format = c("default", "short", "terse")) { - assert_diff_time(dt) units(dt) <- "secs" diff --git a/R/time.R b/R/time.R index 231edc4e..d56454e6 100644 --- a/R/time.R +++ b/R/time.R @@ -1,6 +1,4 @@ - format_time <- local({ - parse_ms <- function(ms) { stopifnot(is.numeric(ms)) @@ -14,10 +12,9 @@ format_time <- local({ first_positive <- function(x) which(x > 0)[1] - trim <- function (x) gsub("^\\s+|\\s+$", "", x) + trim <- function(x) gsub("^\\s+|\\s+$", "", x) pretty_ms <- function(ms, compact = FALSE) { - stopifnot(is.numeric(ms)) parsed <- t(parse_ms(ms)) @@ -35,11 +32,9 @@ format_time <- local({ # handle NAs tmp[is.na(parsed2[idx])] <- NA_character_ tmp - } else { - ## Exact for small ones - exact <- paste0(ceiling(ms), "ms") + exact <- paste0(ceiling(ms), "ms") exact[is.na(ms)] <- NA_character_ ## Approximate for others, in seconds @@ -68,7 +63,6 @@ format_time <- local({ } pretty_dt <- function(dt, compact = FALSE) { - assert_diff_time(dt) units(dt) <- "secs" diff --git a/R/timer.R b/R/timer.R index 0fef223c..38d0320a 100644 --- a/R/timer.R +++ b/R/timer.R @@ -1,4 +1,3 @@ - #' @export `__cli_update_due` <- FALSE diff --git a/R/tree.R b/R/tree.R index e32e8454..73730ec9 100644 --- a/R/tree.R +++ b/R/tree.R @@ -1,4 +1,3 @@ - #' Draw a tree #' #' Draw a tree using box drawing characters. Unicode characters are @@ -115,11 +114,16 @@ #' #' @export - -tree <- function(data, root = data[[1]][[1]], style = NULL, - width = console_width(), trim = FALSE) { +tree <- function( + data, + root = data[[1]][[1]], + style = NULL, + width = console_width(), + trim = FALSE +) { stopifnot( - is.data.frame(data), ncol(data) >= 2, + is.data.frame(data), + ncol(data) >= 2, is_string(root), is.null(style) || (is_tree_style(style)), is_count(width) @@ -134,7 +138,6 @@ tree <- function(data, root = data[[1]][[1]], style = NULL, res <- character() pt <- function(root, n = integer(), mx = integer(), used = character()) { - num_root <- match(root, data[[1]]) if (is.na(num_root)) return() @@ -154,15 +157,18 @@ tree <- function(data, root = data[[1]][[1]], style = NULL, }) root_seen <- root %in% seen - root_lab <- if (trim && root_seen) trimlabs[[num_root]] else labels[[num_root]] + root_lab <- if (trim && root_seen) trimlabs[[num_root]] else + labels[[num_root]] res <<- c(res, paste0(paste(prefix, collapse = ""), root_lab)) # Detect infinite loops if (!trim && root %in% used) { - warning(call. = FALSE, - "Endless loop found in tree: ", - paste0(c(used, root), collapse = " -> ")) - } else if (! trim || ! root_seen) { + warning( + call. = FALSE, + "Endless loop found in tree: ", + paste0(c(used, root), collapse = " -> ") + ) + } else if (!trim || !root_seen) { seen <<- c(seen, root) children <- data[[2]][[num_root]] for (d in seq_along(children)) { @@ -182,17 +188,17 @@ tree <- function(data, root = data[[1]][[1]], style = NULL, box_chars <- function() { if (is_utf8_output()) { list( - "h" = "\u2500", # horizontal - "v" = "\u2502", # vertical - "l" = "\u2514", # leaf - "j" = "\u251C" # junction + "h" = "\u2500", # horizontal + "v" = "\u2502", # vertical + "l" = "\u2514", # leaf + "j" = "\u251C" # junction ) } else { list( - "h" = "-", # horizontal - "v" = "|", # vertical - "l" = "\\", # leaf - "j" = "+" # junction + "h" = "-", # horizontal + "v" = "|", # vertical + "l" = "\\", # leaf + "j" = "+" # junction ) } } diff --git a/R/tty.R b/R/tty.R index f0863734..214a9664 100644 --- a/R/tty.R +++ b/R/tty.R @@ -1,4 +1,3 @@ - is_interactive <- function() { opt <- getOption("rlib_interactive") if (isTRUE(opt)) { @@ -7,7 +6,9 @@ is_interactive <- function() { FALSE } else if (tolower(getOption("knitr.in.progress", "false")) == "true") { FALSE - } else if (tolower(getOption("rstudio.notebook.executing", "false")) == "true") { + } else if ( + tolower(getOption("rstudio.notebook.executing", "false")) == "true" + ) { FALSE } else if (identical(Sys.getenv("TESTTHAT"), "true")) { FALSE @@ -30,7 +31,8 @@ is_interactive <- function() { #' @export cli_output_connection <- function() { - if ((is_interactive() || rstudio_stdout()) && no_sink()) stdout() else stderr() + if ((is_interactive() || rstudio_stdout()) && no_sink()) stdout() else + stderr() } no_sink <- function() { @@ -39,13 +41,14 @@ no_sink <- function() { rstudio_stdout <- function() { rstudio <- rstudio_detect() - rstudio$type %in% c( - "rstudio_console", - "rstudio_console_starting", - "rstudio_build_pane", - "rstudio_job", - "rstudio_render_pane" - ) + rstudio$type %in% + c( + "rstudio_console", + "rstudio_console_starting", + "rstudio_build_pane", + "rstudio_job", + "rstudio_render_pane" + ) } is_stdout <- function(stream) { @@ -56,7 +59,7 @@ is_stderr <- function(stream) { identical(stream, stderr()) && sink.number("message") == 2 } -is_stdx <- function(stream){ +is_stdx <- function(stream) { is_stdout(stream) || is_stderr(stream) } @@ -125,7 +128,6 @@ is_rkward_stdx <- function(stream) { #' is_dynamic_tty(stdout()) is_dynamic_tty <- function(stream = "auto") { - stream <- get_real_output(stream) ## Option? @@ -172,7 +174,6 @@ ANSI_EL <- paste0(ANSI_ESC, "K") #' is_ansi_tty() is_ansi_tty <- function(stream = "auto") { - stream <- get_real_output(stream) # Option takes precedence @@ -246,10 +247,7 @@ set_embedded_utf8 <- function(value = TRUE) { .Call(clic_set_embedded_utf8, value) } -r_utf8 <- function(func, - args = list(), - package = FALSE, - timeout = 5000L) { +r_utf8 <- function(func, args = list(), package = FALSE, timeout = 5000L) { out <- tempfile() on.exit(unlink(out), add = TRUE) opts <- callr::r_process_options( diff --git a/R/unicode.R b/R/unicode.R index 722cb79b..d792c035 100644 --- a/R/unicode.R +++ b/R/unicode.R @@ -1,4 +1,3 @@ - #' Working around the bad Unicode character widths #' #' R 3.6.2 and also the coming 3.6.3 and 4.0.0 versions use the Unicode 8 diff --git a/R/utf8.R b/R/utf8.R index 9a3cce73..e8b2ac68 100644 --- a/R/utf8.R +++ b/R/utf8.R @@ -1,4 +1,3 @@ - #' Whether cli is emitting UTF-8 characters #' #' UTF-8 cli characters can be turned on by setting the `cli.unicode` @@ -12,7 +11,7 @@ is_utf8_output <- function() { opt <- getOption("cli.unicode", NULL) - if (! is.null(opt)) { + if (!is.null(opt)) { isTRUE(opt) } else { l10n_info()$`UTF-8` && !is_latex_output() @@ -52,9 +51,10 @@ is_utf8_output <- function() { #' nchar(emo, "bytes") #' nchar(emo, "width") -utf8_nchar <- function(x, type = c("chars", "bytes", "width", "graphemes", - "codepoints")) { - +utf8_nchar <- function( + x, + type = c("chars", "bytes", "width", "graphemes", "codepoints") +) { type <- match.arg(type) if (type == "chars") type <- "graphemes" @@ -62,14 +62,12 @@ utf8_nchar <- function(x, type = c("chars", "bytes", "width", "graphemes", if (type == "width") { .Call(clic_utf8_display_width, x) - } else if (type == "graphemes") { .Call(clic_utf8_nchar_graphemes, x) - } else if (type == "codepoints") { base::nchar(x, allowNA = FALSE, keepNA = TRUE, type = "chars") - - } else { # bytes + } else { + # bytes base::nchar(x, allowNA = FALSE, keepNA = TRUE, type = "bytes") } } @@ -107,7 +105,7 @@ utf8_substr <- function(x, start, stop) { throw(cli_error( "{.arg start} and {.arg stop} must be numeric vectors", "i" = if (!is.numeric(start)) "{.arg start} is {.typeof {start}}", - "i" = if (!is.numeric(stop)) "{.arg stop} is {.typeof {stop}}" + "i" = if (!is.numeric(stop)) "{.arg stop} is {.typeof {stop}}" )) } start2 <- suppressWarnings(as.integer(start)) @@ -116,7 +114,7 @@ utf8_substr <- function(x, start, stop) { throw(cli_error( "{.arg start} and {.arg stop} must have at least length 1", "i" = if (!length(start2)) "{.arg start} has length 0", - "i" = if (!length(stop2)) "{.arg stop} has length 0" + "i" = if (!length(stop2)) "{.arg stop} has length 0" )) } x <- enc2utf8(x) diff --git a/R/utils.R b/R/utils.R index f923ec8a..c83ff461 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1,4 +1,3 @@ - is_yes <- function(x) { tolower(x) %in% c("true", "yes", "y", "t", "1") } @@ -19,7 +18,7 @@ cli_escape <- function(x) { # missing from older R -isFALSE <- function (x) { +isFALSE <- function(x) { is.logical(x) && length(x) == 1L && !is.na(x) && !x } diff --git a/R/vt.R b/R/vt.R index 2ebaedfb..0872061a 100644 --- a/R/vt.R +++ b/R/vt.R @@ -1,4 +1,3 @@ - #' Simulate (a subset of) a VT-5xx ANSI terminal #' #' This is utility function that calculates the state of a VT-5xx screen @@ -68,9 +67,9 @@ vt_output <- function(output, width = 80L, height = 25L) { utf8_substr(line, s + 1, e) }) - fg <- re_match(lgs$values, "fg:([0-9]+|#[0-9a-f]+);")[,1] - bg <- re_match(lgs$values, "bg:([0-9]+|#[0-9a-f]+);")[,1] - linkno <- as.integer(re_match(lgs$values, "link:([0-9]+);")[,1]) + fg <- re_match(lgs$values, "fg:([0-9]+|#[0-9a-f]+);")[, 1] + bg <- re_match(lgs$values, "bg:([0-9]+|#[0-9a-f]+);")[, 1] + linkno <- as.integer(re_match(lgs$values, "link:([0-9]+);")[, 1]) link <- links[linkno] link_params <- links_params[linkno] diff --git a/R/width.R b/R/width.R index 98b51105..70f4f303 100644 --- a/R/width.R +++ b/R/width.R @@ -1,4 +1,3 @@ - #' Determine the width of the console #' #' It uses the `cli.width` option, if set. Otherwise it tries to @@ -68,21 +67,17 @@ console_width <- function() { if (rs$type == "not_rstudio") { # maybe a terminal? width <- terminal_width() - } else if (rs$type == "rstudio_console_starting") { # there isn't much we can do here, options and env vars are not set width <- NULL - } else if (rs$type == "rstudio_console") { # will just use getOption("width"), in case the user changed it, # and ignore the RSTUDIO_CONSOLE_WIDTH env var width <- NULL - } else if (rs$type == "rstudio_build_pane") { # RStudio explicitly sets this for build pane processes # It is only good when the build starts, but we cannot do better width <- rs_console_width() - } else if (rs$type == "rstudio_terminal") { # Can also be a subprocess of the terminal, with a pty, # but that's fine, the pty should have a width set up. @@ -90,8 +85,8 @@ console_width <- function() { # because the user might have changed options("width") and the env # var is only good when the terminal starts, anyway. width <- terminal_width() - - } else { # rstudio_subprocess + } else { + # rstudio_subprocess width <- NULL } diff --git a/R/zzz.R b/R/zzz.R index c4b4a7ff..299a9cd5 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -1,4 +1,3 @@ - #' ANSI colored text #' #' cli has a number of functions to color and style text at the command @@ -94,143 +93,143 @@ NULL #' @export #' @name ansi-styles -bg_black <- create_ansi_style("bg_black") +bg_black <- create_ansi_style("bg_black") #' @export #' @name ansi-styles -bg_blue <- create_ansi_style("bg_blue") +bg_blue <- create_ansi_style("bg_blue") #' @export #' @name ansi-styles -bg_cyan <- create_ansi_style("bg_cyan") +bg_cyan <- create_ansi_style("bg_cyan") #' @export #' @name ansi-styles -bg_green <- create_ansi_style("bg_green") +bg_green <- create_ansi_style("bg_green") #' @export #' @name ansi-styles -bg_magenta <- create_ansi_style("bg_magenta") +bg_magenta <- create_ansi_style("bg_magenta") #' @export #' @name ansi-styles -bg_red <- create_ansi_style("bg_red") +bg_red <- create_ansi_style("bg_red") #' @export #' @name ansi-styles -bg_white <- create_ansi_style("bg_white") +bg_white <- create_ansi_style("bg_white") #' @export #' @name ansi-styles -bg_yellow <- create_ansi_style("bg_yellow") +bg_yellow <- create_ansi_style("bg_yellow") #' @export #' @name ansi-styles bg_none <- create_ansi_style("no_bg_color") #' @export #' @name ansi-styles -bg_br_black <- create_ansi_style("bg_br_black") +bg_br_black <- create_ansi_style("bg_br_black") #' @export #' @name ansi-styles -bg_br_blue <- create_ansi_style("bg_br_blue") +bg_br_blue <- create_ansi_style("bg_br_blue") #' @export #' @name ansi-styles -bg_br_cyan <- create_ansi_style("bg_br_cyan") +bg_br_cyan <- create_ansi_style("bg_br_cyan") #' @export #' @name ansi-styles -bg_br_green <- create_ansi_style("bg_br_green") +bg_br_green <- create_ansi_style("bg_br_green") #' @export #' @name ansi-styles -bg_br_magenta <- create_ansi_style("bg_br_magenta") +bg_br_magenta <- create_ansi_style("bg_br_magenta") #' @export #' @name ansi-styles -bg_br_red <- create_ansi_style("bg_br_red") +bg_br_red <- create_ansi_style("bg_br_red") #' @export #' @name ansi-styles -bg_br_white <- create_ansi_style("bg_br_white") +bg_br_white <- create_ansi_style("bg_br_white") #' @export #' @name ansi-styles -bg_br_yellow <- create_ansi_style("bg_br_yellow") +bg_br_yellow <- create_ansi_style("bg_br_yellow") #' @export #' @name ansi-styles -col_black <- create_ansi_style("black") +col_black <- create_ansi_style("black") #' @export #' @name ansi-styles -col_blue <- create_ansi_style("blue") +col_blue <- create_ansi_style("blue") #' @export #' @name ansi-styles -col_cyan <- create_ansi_style("cyan") +col_cyan <- create_ansi_style("cyan") #' @export #' @name ansi-styles -col_green <- create_ansi_style("green") +col_green <- create_ansi_style("green") #' @export #' @name ansi-styles col_magenta <- create_ansi_style("magenta") #' @export #' @name ansi-styles -col_red <- create_ansi_style("red") +col_red <- create_ansi_style("red") #' @export #' @name ansi-styles -col_white <- create_ansi_style("white") +col_white <- create_ansi_style("white") #' @export #' @name ansi-styles -col_yellow <- create_ansi_style("yellow") +col_yellow <- create_ansi_style("yellow") #' @export #' @name ansi-styles -col_grey <- create_ansi_style("silver") +col_grey <- create_ansi_style("silver") #' @export #' @name ansi-styles -col_silver <- create_ansi_style("silver") +col_silver <- create_ansi_style("silver") #' @export #' @name ansi-styles col_none <- create_ansi_style("no_color") #' @export #' @name ansi-styles -col_br_black <- create_ansi_style("br_black") +col_br_black <- create_ansi_style("br_black") #' @export #' @name ansi-styles -col_br_blue <- create_ansi_style("br_blue") +col_br_blue <- create_ansi_style("br_blue") #' @export #' @name ansi-styles -col_br_cyan <- create_ansi_style("br_cyan") +col_br_cyan <- create_ansi_style("br_cyan") #' @export #' @name ansi-styles -col_br_green <- create_ansi_style("br_green") +col_br_green <- create_ansi_style("br_green") #' @export #' @name ansi-styles col_br_magenta <- create_ansi_style("br_magenta") #' @export #' @name ansi-styles -col_br_red <- create_ansi_style("br_red") +col_br_red <- create_ansi_style("br_red") #' @export #' @name ansi-styles -col_br_white <- create_ansi_style("br_white") +col_br_white <- create_ansi_style("br_white") #' @export #' @name ansi-styles -col_br_yellow <- create_ansi_style("br_yellow") +col_br_yellow <- create_ansi_style("br_yellow") #' @export #' @name ansi-styles -style_dim <- create_ansi_style("blurred") +style_dim <- create_ansi_style("blurred") #' @export #' @name ansi-styles -style_blurred <- create_ansi_style("blurred") +style_blurred <- create_ansi_style("blurred") #' @export #' @name ansi-styles -style_bold <- create_ansi_style("bold") +style_bold <- create_ansi_style("bold") #' @export #' @name ansi-styles -style_hidden <- create_ansi_style("hidden") +style_hidden <- create_ansi_style("hidden") #' @export #' @name ansi-styles -style_inverse <- create_ansi_style("inverse") +style_inverse <- create_ansi_style("inverse") #' @export #' @name ansi-styles -style_italic <- create_ansi_style("italic") +style_italic <- create_ansi_style("italic") #' @export #' @name ansi-styles -style_reset <- create_ansi_style("reset") +style_reset <- create_ansi_style("reset") #' @export #' @name ansi-styles style_strikethrough <- create_ansi_style("strikethrough") #' @export #' @name ansi-styles -style_underline <- create_ansi_style("underline") +style_underline <- create_ansi_style("underline") #' @export #' @name ansi-styles diff --git a/air.toml b/air.toml new file mode 100644 index 00000000..e69de29b diff --git a/exec/news.R b/exec/news.R index 99c15573..4a9c58a6 100755 --- a/exec/news.R +++ b/exec/news.R @@ -4,41 +4,46 @@ setup_app <- function() { theme <- list( "url" = list(color = "blue"), ".pkg" = list(color = "orange"), - "it" = list("margin-bottom" = 1)) + "it" = list("margin-bottom" = 1) + ) start_app(theme = theme, output = "stdout") } load_packages <- function() { - tryCatch({ - library(cli) - library(httr) - library(jsonlite) - library(prettyunits) - library(glue) - library(parsedate) - library(docopt) }, + tryCatch( + { + library(cli) + library(httr) + library(jsonlite) + library(prettyunits) + library(glue) + library(parsedate) + library(docopt) + }, error = function(e) { cli_alert_danger( - "The {.pkg glue}, {.pkg httr}, {.pkg jsonlite}, {.pkg prettyunits},", - " {.pkg parsedate} and {.pkg docopt} packages are needed!") + "The {.pkg glue}, {.pkg httr}, {.pkg jsonlite}, {.pkg prettyunits},", + " {.pkg parsedate} and {.pkg docopt} packages are needed!" + ) q(save = "no", status = 1) - }) + } + ) } -news <- function(n = 10, day = FALSE, week = FALSE, since = NULL, - reverse = FALSE) { - +news <- function( + n = 10, + day = FALSE, + week = FALSE, + since = NULL, + reverse = FALSE +) { load_packages() setup_app() - - result <- if (day) - news_day() - else if (week) - news_week() - else if (!is.null(since)) - news_since(since) - else - news_n(as.numeric(n)) + + result <- if (day) news_day() else if (week) news_week() else if ( + !is.null(since) + ) + news_since(since) else news_n(as.numeric(n)) if (reverse) result <- rev(result) @@ -47,13 +52,13 @@ news <- function(n = 10, day = FALSE, week = FALSE, since = NULL, } news_day <- function() { - date <- format_iso_8601(Sys.time() - as.difftime(1, units="days")) + date <- format_iso_8601(Sys.time() - as.difftime(1, units = "days")) ep <- glue("/-/pkgreleases?descending=true&endkey=%22{date}%22") do_query(ep) } news_week <- function() { - date <- format_iso_8601(Sys.time() - as.difftime(7, units="days")) + date <- format_iso_8601(Sys.time() - as.difftime(7, units = "days")) ep <- glue("/-/pkgreleases?descending=true&endkey=%22{date}%22") do_query(ep) } @@ -84,7 +89,6 @@ format_results <- function(results) { } parse_arguments <- function() { - "Usage: news.R [-r | --reverse] [-n num ] news.R [-r | --reverse] --day | --week | --since date @@ -109,8 +113,10 @@ format_result <- function(result) { ago <- vague_dt(Sys.time() - parse_iso_8601(result$date)) url <- paste0("https://r-pkg.org/pkg/", pkg$Package) cli_li() - cli_text("{.pkg {pkg$Package}} {pkg$Version} -- - {ago} by {.emph {pkg$Maintainer}}") + cli_text( + "{.pkg {pkg$Package}} {pkg$Version} -- + {ago} by {.emph {pkg$Maintainer}}" + ) cli_text("{pkg$Title}") cli_text("{.url {url}}") } diff --git a/exec/outdated.R b/exec/outdated.R index 38872677..51f5bbf1 100755 --- a/exec/outdated.R +++ b/exec/outdated.R @@ -6,19 +6,25 @@ setup_app <- function() { theme <- list( "url" = list(color = "blue"), - ".pkg" = list(color = "orange")) + ".pkg" = list(color = "orange") + ) start_app(theme = theme, output = "stdout") } load_packages <- function() { - tryCatch(suppressPackageStartupMessages({ - library(cli) - library(pkgcache) - library(docopt) }), + tryCatch( + suppressPackageStartupMessages({ + library(cli) + library(pkgcache) + library(docopt) + }), error = function(e) { - cli_alert_danger("The {.pkg pkgcache} and {.pkg docopt} packages are needed!") + cli_alert_danger( + "The {.pkg pkgcache} and {.pkg docopt} packages are needed!" + ) q(save = "no", status = 1) - }) + } + ) } outdated <- function(lib = NULL, notcran = FALSE) { @@ -35,7 +41,7 @@ outdated <- function(lib = NULL, notcran = FALSE) { pkg <- inst[i, "Package"] iver <- inst[i, "Version"] - if (! pkg %in% repo$package) { + if (!pkg %in% repo$package) { cli_alert_info("{.pkg {pkg}}: \tnot a CRAN/BioC package") next } @@ -51,7 +57,8 @@ outdated <- function(lib = NULL, notcran = FALSE) { src <- if (any(newest$platform == "source")) "src" else "" cli_alert_danger( - "{.pkg {pkg}} \t{iver} {symbol$arrow_right} {mnver} {emph ({bin} {src})}") + "{.pkg {pkg}} \t{iver} {symbol$arrow_right} {mnver} {emph ({bin} {src})}" + ) } } diff --git a/exec/search.R b/exec/search.R index f635b938..c1a36ba5 100755 --- a/exec/search.R +++ b/exec/search.R @@ -3,7 +3,8 @@ setup_app <- function() { theme <- list( "url" = list(color = "blue"), - ".pkg" = list(color = "orange")) + ".pkg" = list(color = "orange") + ) start_app(theme = theme, output = "stdout") } @@ -15,7 +16,8 @@ load_packages <- function() { library(prettyunits) error = function(e) { cli_alert_danger( - "The {.pkg pkgsearch}, {.pkg prettyunits} and {.pkg docopt} packages are needed!") + "The {.pkg pkgsearch}, {.pkg prettyunits} and {.pkg docopt} packages are needed!" + ) q(save = "no", status = 1) } }) @@ -49,14 +51,16 @@ format_result <- function(obj, from, size) { cli_div(theme = list(ul = list("list-style-type" = ""))) cli_ol() - lapply(seq_len(nrow(obj)), function(i) format_hit(obj[i,])) + lapply(seq_len(nrow(obj)), function(i) format_hit(obj[i, ])) } format_hit <- function(hit) { ago <- vague_dt(Sys.time() - hit$date) cli_li() - cli_text("{.pkg {hit$package}} {hit$version} -- - {.emph {hit$title}}") + cli_text( + "{.pkg {hit$package}} {hit$version} -- + {.emph {hit$title}}" + ) cli_par() cli_text(hit$description) cli_text("{.emph {ago} by {hit$maintainer_name}}") @@ -79,7 +83,9 @@ Seach for CRAN packages on r-pkg.org if (is.null(sys.calls())) { load_packages() opts <- parse_arguments() - search(opts$term, - from = as.numeric(opts$f %||% 1), - size = as.numeric(opts$n %||% 5)) + search( + opts$term, + from = as.numeric(opts$f %||% 1), + size = as.numeric(opts$n %||% 5) + ) } diff --git a/exec/up.R b/exec/up.R index 3f8f3336..cc44c79c 100755 --- a/exec/up.R +++ b/exec/up.R @@ -9,32 +9,36 @@ setup_app <- function() { } load_packages <- function() { - tryCatch({ - library(cli) - library(async) - library(docopt) }, + tryCatch( + { + library(cli) + library(async) + library(docopt) + }, error = function(e) { - cli_alert_danger("The {.pkg async} and {.pkg docopt} packages are needed!") + cli_alert_danger( + "The {.pkg async} and {.pkg docopt} packages are needed!" + ) q(save = "no", status = 1) - }) + } + ) } up <- function(urls, timeout = 5) { load_packages() setup_app() chk_url <- async(function(url, ...) { - http_head(url, ...)$ - then(function(res) { - if (res$status_code < 300) { - cli_alert_success("{.url {url}} ({res$times[['total']]}s)") - } else { - cli_alert_danger("{.url {url}} (HTTP {res$status_code})") - } - })$ - catch(error = function(err) { - e <- if (grepl("timed out", err$message, fixed = TRUE)) "timed out" else "error" - cli_alert_danger("{.url {url}} ({e})") - }) + http_head(url, ...)$then(function(res) { + if (res$status_code < 300) { + cli_alert_success("{.url {url}} ({res$times[['total']]}s)") + } else { + cli_alert_danger("{.url {url}} (HTTP {res$status_code})") + } + })$catch(error = function(err) { + e <- if (grepl("timed out", err$message, fixed = TRUE)) "timed out" else + "error" + cli_alert_danger("{.url {url}} ({e})") + }) }) invisible(synchronise( @@ -43,7 +47,6 @@ up <- function(urls, timeout = 5) { } parse_arguments <- function() { - "Usage: up.R [-t timeout] [URLS ...] up.R -h | --help @@ -57,7 +60,7 @@ Check if web sites are up. docopt(doc) } - + if (is.null(sys.calls())) { load_packages() opts <- parse_arguments() diff --git a/inst/examples/apps/news.R b/inst/examples/apps/news.R index 99c15573..4a9c58a6 100755 --- a/inst/examples/apps/news.R +++ b/inst/examples/apps/news.R @@ -4,41 +4,46 @@ setup_app <- function() { theme <- list( "url" = list(color = "blue"), ".pkg" = list(color = "orange"), - "it" = list("margin-bottom" = 1)) + "it" = list("margin-bottom" = 1) + ) start_app(theme = theme, output = "stdout") } load_packages <- function() { - tryCatch({ - library(cli) - library(httr) - library(jsonlite) - library(prettyunits) - library(glue) - library(parsedate) - library(docopt) }, + tryCatch( + { + library(cli) + library(httr) + library(jsonlite) + library(prettyunits) + library(glue) + library(parsedate) + library(docopt) + }, error = function(e) { cli_alert_danger( - "The {.pkg glue}, {.pkg httr}, {.pkg jsonlite}, {.pkg prettyunits},", - " {.pkg parsedate} and {.pkg docopt} packages are needed!") + "The {.pkg glue}, {.pkg httr}, {.pkg jsonlite}, {.pkg prettyunits},", + " {.pkg parsedate} and {.pkg docopt} packages are needed!" + ) q(save = "no", status = 1) - }) + } + ) } -news <- function(n = 10, day = FALSE, week = FALSE, since = NULL, - reverse = FALSE) { - +news <- function( + n = 10, + day = FALSE, + week = FALSE, + since = NULL, + reverse = FALSE +) { load_packages() setup_app() - - result <- if (day) - news_day() - else if (week) - news_week() - else if (!is.null(since)) - news_since(since) - else - news_n(as.numeric(n)) + + result <- if (day) news_day() else if (week) news_week() else if ( + !is.null(since) + ) + news_since(since) else news_n(as.numeric(n)) if (reverse) result <- rev(result) @@ -47,13 +52,13 @@ news <- function(n = 10, day = FALSE, week = FALSE, since = NULL, } news_day <- function() { - date <- format_iso_8601(Sys.time() - as.difftime(1, units="days")) + date <- format_iso_8601(Sys.time() - as.difftime(1, units = "days")) ep <- glue("/-/pkgreleases?descending=true&endkey=%22{date}%22") do_query(ep) } news_week <- function() { - date <- format_iso_8601(Sys.time() - as.difftime(7, units="days")) + date <- format_iso_8601(Sys.time() - as.difftime(7, units = "days")) ep <- glue("/-/pkgreleases?descending=true&endkey=%22{date}%22") do_query(ep) } @@ -84,7 +89,6 @@ format_results <- function(results) { } parse_arguments <- function() { - "Usage: news.R [-r | --reverse] [-n num ] news.R [-r | --reverse] --day | --week | --since date @@ -109,8 +113,10 @@ format_result <- function(result) { ago <- vague_dt(Sys.time() - parse_iso_8601(result$date)) url <- paste0("https://r-pkg.org/pkg/", pkg$Package) cli_li() - cli_text("{.pkg {pkg$Package}} {pkg$Version} -- - {ago} by {.emph {pkg$Maintainer}}") + cli_text( + "{.pkg {pkg$Package}} {pkg$Version} -- + {ago} by {.emph {pkg$Maintainer}}" + ) cli_text("{pkg$Title}") cli_text("{.url {url}}") } diff --git a/inst/examples/apps/outdated.R b/inst/examples/apps/outdated.R index 542c5c67..f2aa4f1c 100755 --- a/inst/examples/apps/outdated.R +++ b/inst/examples/apps/outdated.R @@ -6,19 +6,25 @@ setup_app <- function() { theme <- list( "url" = list(color = "blue"), - ".pkg" = list(color = "orange")) + ".pkg" = list(color = "orange") + ) start_app(theme = theme, output = "stdout") } load_packages <- function() { - tryCatch(suppressPackageStartupMessages({ - library(cli) - library(pkgcache) - library(docopt) }), + tryCatch( + suppressPackageStartupMessages({ + library(cli) + library(pkgcache) + library(docopt) + }), error = function(e) { - cli_alert_danger("The {.pkg pkgcache} and {.pkg docopt} packages are needed!") + cli_alert_danger( + "The {.pkg pkgcache} and {.pkg docopt} packages are needed!" + ) q(save = "no", status = 1) - }) + } + ) } outdated <- function(lib = NULL, notcran = FALSE) { @@ -35,7 +41,7 @@ outdated <- function(lib = NULL, notcran = FALSE) { pkg <- inst[i, "Package"] iver <- inst[i, "Version"] - if (! pkg %in% repo$package) { + if (!pkg %in% repo$package) { cli_alert_info("{.pkg {pkg}}: \tnot a CRAN/BioC package") next } @@ -52,7 +58,8 @@ outdated <- function(lib = NULL, notcran = FALSE) { cli_alert_danger("{.emph {pkg}}") cli_alert_danger( - "{.pkg {pkg}} \t{iver} {symbol$arrow_right} {mnver} {.emph ({bin} {src})}") + "{.pkg {pkg}} \t{iver} {symbol$arrow_right} {mnver} {.emph ({bin} {src})}" + ) } } diff --git a/inst/examples/apps/search.R b/inst/examples/apps/search.R index 51e6501a..5fd31a2e 100755 --- a/inst/examples/apps/search.R +++ b/inst/examples/apps/search.R @@ -3,7 +3,8 @@ setup_app <- function() { theme <- list( "url" = list(color = "blue"), - ".pkg" = list(color = "orange")) + ".pkg" = list(color = "orange") + ) start_app(theme = theme, output = "stdout") } @@ -15,7 +16,8 @@ load_packages <- function() { library(prettyunits) error = function(e) { cli_alert_danger( - "The {.pkg pkgsearch}, {.pkg prettyunits} and {.pkg docopt} packages are needed!") + "The {.pkg pkgsearch}, {.pkg prettyunits} and {.pkg docopt} packages are needed!" + ) q(save = "no", status = 1) } }) @@ -49,14 +51,16 @@ format_result <- function(obj, from, size) { cli_div(theme = list(ul = list("list-style-type" = ""))) cli_ol() - lapply(seq_len(nrow(obj)), function(i) format_hit(obj[i,])) + lapply(seq_len(nrow(obj)), function(i) format_hit(obj[i, ])) } format_hit <- function(hit) { ago <- vague_dt(Sys.time() - hit$date) cli_li() - cli_text("{.pkg {hit$package}} {hit$version} -- - {.emph {hit$title}}") + cli_text( + "{.pkg {hit$package}} {hit$version} -- + {.emph {hit$title}}" + ) cli_par() cli_text(hit$description) cli_text("{.emph {ago} by {hit$maintainer_name}}") @@ -79,7 +83,9 @@ Seach for CRAN packages on r-pkg.org if (is.null(sys.calls())) { load_packages() opts <- parse_arguments() - search(opts$term, - from = as.numeric(opts$f %||% 1), - size = as.numeric(opts$n %||% 5)) + search( + opts$term, + from = as.numeric(opts$f %||% 1), + size = as.numeric(opts$n %||% 5) + ) } diff --git a/inst/examples/apps/up.R b/inst/examples/apps/up.R index b87ac498..946e06aa 100755 --- a/inst/examples/apps/up.R +++ b/inst/examples/apps/up.R @@ -9,32 +9,35 @@ setup_app <- function() { } load_packages <- function() { - tryCatch({ - library(cliapp) - library(async) - library(docopt) }, + tryCatch( + { + library(cliapp) + library(async) + library(docopt) + }, error = function(e) { - cli_alert_danger("The {.pkg async} and {.pkg docopt} packages are needed!") + cli_alert_danger( + "The {.pkg async} and {.pkg docopt} packages are needed!" + ) q(save = "no", status = 1) - }) + } + ) } up <- function(urls, timeout = 5) { load_packages() setup_app() chk_url <- async(function(url, ...) { - http_head(url, ...)$ - then(function(res) { - if (res$status_code < 300) { - cli_alert_success("{.url {url}} ({res$times[['total']]}s)") - } else { - cli_alert_danger("{.url {url}} (HTTP {res$status_code})") - } - })$ - catch(error = function(err) { - e <- if (grepl("timed out", err$message)) "timed out" else "error" - cli_alert_danger("{.url {url}} ({e})") - }) + http_head(url, ...)$then(function(res) { + if (res$status_code < 300) { + cli_alert_success("{.url {url}} ({res$times[['total']]}s)") + } else { + cli_alert_danger("{.url {url}} (HTTP {res$status_code})") + } + })$catch(error = function(err) { + e <- if (grepl("timed out", err$message)) "timed out" else "error" + cli_alert_danger("{.url {url}} ({e})") + }) }) invisible(synchronise( @@ -43,7 +46,6 @@ up <- function(urls, timeout = 5) { } parse_arguments <- function() { - "Usage: up.R [-t timeout] [URLS ...] up.R -h | --help @@ -57,7 +59,7 @@ Check if web sites are up. docopt(doc) } - + if (is.null(sys.calls())) { load_packages() opts <- parse_arguments() diff --git a/inst/shiny/along/app.R b/inst/shiny/along/app.R index 7300de1d..735a68b5 100644 --- a/inst/shiny/along/app.R +++ b/inst/shiny/along/app.R @@ -17,10 +17,10 @@ options(cli.progress_handlers_only = c("shiny", "logger")) server <- function(input, output) { output$plot <- renderPlot({ input$goPlot # Re-run when button is clicked - + # Create 0-row data frame which will be used to store data dat <- data.frame(x = numeric(0), y = numeric(0)) - + # Number of times we'll go through the loop n <- 10 diff --git a/inst/shiny/format/app.R b/inst/shiny/format/app.R index f134c97a..068f22db 100644 --- a/inst/shiny/format/app.R +++ b/inst/shiny/format/app.R @@ -17,10 +17,10 @@ options(cli.progress_handlers_only = c("shiny", "logger")) server <- function(input, output) { output$plot <- renderPlot({ input$goPlot # Re-run when button is clicked - + # Create 0-row data frame which will be used to store data dat <- data.frame(x = numeric(0), y = numeric(0)) - + # Number of times we'll go through the loop n <- 10 diff --git a/inst/shiny/nested/app.R b/inst/shiny/nested/app.R index db839566..d93ade7a 100644 --- a/inst/shiny/nested/app.R +++ b/inst/shiny/nested/app.R @@ -17,10 +17,10 @@ options(cli.progress_handlers_only = c("shiny", "logger")) server <- function(input, output) { output$plot <- renderPlot({ input$goPlot # Re-run when button is clicked - + # Create 0-row data frame which will be used to store data dat <- data.frame(x = numeric(0), y = numeric(0)) - + # Number of times we'll go through the loop n <- 10 diff --git a/inst/shiny/simple/app.R b/inst/shiny/simple/app.R index c87e431e..e09cf468 100644 --- a/inst/shiny/simple/app.R +++ b/inst/shiny/simple/app.R @@ -15,10 +15,10 @@ options(cli.progress_handlers_only = c("shiny", "logger")) server <- function(input, output) { output$plot <- renderPlot({ input$goPlot # Re-run when button is clicked - + # Create 0-row data frame which will be used to store data dat <- data.frame(x = numeric(0), y = numeric(0)) - + # Number of times we'll go through the loop n <- 10 diff --git a/man/roxygen/meta.R b/man/roxygen/meta.R index fd94ea9f..6b888731 100644 --- a/man/roxygen/meta.R +++ b/man/roxygen/meta.R @@ -1,4 +1,3 @@ - if (exists(".knitr_asciicast_process", envir = .GlobalEnv)) { rm(list = ".knitr_asciicast_process", envir = .GlobalEnv) } diff --git a/tests/testthat/helper.R b/tests/testthat/helper.R index 77f87997..35361e40 100644 --- a/tests/testthat/helper.R +++ b/tests/testthat/helper.R @@ -1,6 +1,8 @@ - rule_class <- function(x) { - structure(x, class = c("cli_rule", "rule", "cli_ansi_string", "ansi_string", "character")) + structure( + x, + class = c("cli_rule", "rule", "cli_ansi_string", "ansi_string", "character") + ) } capture_msgs <- function(expr) { @@ -8,7 +10,8 @@ capture_msgs <- function(expr) { i <- 0 suppressMessages(withCallingHandlers( expr, - message = function(e) msgs[[i <<- i + 1]] <<- conditionMessage(e))) + message = function(e) msgs[[i <<- i + 1]] <<- conditionMessage(e) + )) paste0(msgs, collapse = "") } @@ -31,12 +34,16 @@ capt <- function(expr, print_it = TRUE) { capt0 <- function(expr, strip_style = FALSE) { out <- capture_msgs(expr) - if (strip_style) ansi_strip(out) else out + if (strip_style) ansi_strip(out) else out } -local_cli_config <- function(unicode = FALSE, dynamic = FALSE, - ansi = FALSE, num_colors = 1, - .local_envir = parent.frame()) { +local_cli_config <- function( + unicode = FALSE, + dynamic = FALSE, + ansi = FALSE, + num_colors = 1, + .local_envir = parent.frame() +) { withr::local_options( cli.dynamic = dynamic, cli.ansi = ansi, @@ -58,14 +65,17 @@ test_style <- function() { "font-weight" = "bold", "font-style" = "italic", "margin-top" = 1, - "margin-bottom" = 1), + "margin-bottom" = 1 + ), ".testcli h2" = list( "font-weight" = "bold", "margin-top" = 1, - "margin-bottom" = 1), + "margin-bottom" = 1 + ), ".testcli h3" = list( "text-decoration" = "underline", - "margin-top" = 1) + "margin-top" = 1 + ) ) } @@ -90,13 +100,15 @@ fix_logger_output <- function(lines) { ) } -make_c_function <- function(file = NULL, - code = NULL, - args = character(), - type = c(".c", ".cpp"), - header = NULL, - linkingto = packageName(), - quiet = Sys.getenv("TESTTHAT") == "true") { +make_c_function <- function( + file = NULL, + code = NULL, + args = character(), + type = c(".c", ".cpp"), + header = NULL, + linkingto = packageName(), + quiet = Sys.getenv("TESTTHAT") == "true" +) { type <- match.arg(type) # Create source file @@ -147,7 +159,7 @@ create_c_function_call <- function(code, args, header = NULL) { ) } -win2unix <- function (str) { +win2unix <- function(str) { gsub("\r\n", "\n", str, fixed = TRUE, useBytes = TRUE) } @@ -162,15 +174,18 @@ st_to_bel <- function(x) { test_package_root <- function() { x <- tryCatch( rprojroot::find_package_root_file(), - error = function(e) NULL) + error = function(e) NULL + ) if (!is.null(x)) return(x) pkg <- testthat::testing_package() x <- tryCatch( rprojroot::find_package_root_file( - path = file.path("..", "..", "00_pkg_src", pkg)), - error = function(e) NULL) + path = file.path("..", "..", "00_pkg_src", pkg) + ), + error = function(e) NULL + ) if (!is.null(x)) return(x) @@ -198,11 +213,14 @@ sanitize_call <- function(x) { r_pty <- function(.envir = parent.frame()) { skip_on_cran() # TODO: why does this fail on the CI, in covr - if (Sys.getenv("R_COVR") == "true" && - isTRUE(as.logical(Sys.getenv("CI")))) { + if ( + Sys.getenv("R_COVR") == "true" && + isTRUE(as.logical(Sys.getenv("CI"))) + ) { skip("fails on CI in covr") } - if (!Sys.info()[["sysname"]] %in% c("Darwin", "Linux")) skip("Needs Linux or macOS") + if (!Sys.info()[["sysname"]] %in% c("Darwin", "Linux")) + skip("Needs Linux or macOS") r <- file.path(R.home("bin"), "R") p <- processx::process$new( @@ -212,11 +230,14 @@ r_pty <- function(.envir = parent.frame()) { env = c("current", R_CLI_HIDE_CURSOR = "false", R_LIBS = .libPaths()[1]) ) - defer({ - close(p$get_input_connection()) - p$wait(1000) - p$kill() - }, envir = .envir) + defer( + { + close(p$get_input_connection()) + p$wait(1000) + p$kill() + }, + envir = .envir + ) p$poll_io(1000) p$read_output() diff --git a/tests/testthat/progresstest/R/test.R b/tests/testthat/progresstest/R/test.R index 8d2b8a85..8ae5f0df 100644 --- a/tests/testthat/progresstest/R/test.R +++ b/tests/testthat/progresstest/R/test.R @@ -1,4 +1,3 @@ - #' @useDynLib progresstest, .registration = TRUE, .fixes = "c_" NULL diff --git a/tests/testthat/progresstestcpp/R/testcpp.R b/tests/testthat/progresstestcpp/R/testcpp.R index b05d5f40..862258fc 100644 --- a/tests/testthat/progresstestcpp/R/testcpp.R +++ b/tests/testthat/progresstestcpp/R/testcpp.R @@ -1,4 +1,3 @@ - #' @useDynLib progresstestcpp, .registration = TRUE NULL diff --git a/tests/testthat/setup.R b/tests/testthat/setup.R index 81f61850..36f1abbc 100644 --- a/tests/testthat/setup.R +++ b/tests/testthat/setup.R @@ -1,4 +1,3 @@ - unlink(dir( file.path(dirname(dirname(normalizePath(test_path()))), "src"), pattern = "[.]gcda$", diff --git a/tests/testthat/test-alerts.R b/tests/testthat/test-alerts.R index 5c02a8e7..76d96303 100644 --- a/tests/testthat/test-alerts.R +++ b/tests/testthat/test-alerts.R @@ -1,4 +1,3 @@ - start_app() on.exit(stop_app(), add = TRUE) diff --git a/tests/testthat/test-ansi-combine.R b/tests/testthat/test-ansi-combine.R index f6a25426..1a8f8915 100644 --- a/tests/testthat/test-ansi-combine.R +++ b/tests/testthat/test-ansi-combine.R @@ -1,4 +1,3 @@ - test_that("one style", { testthat::skip_on_covr() # because we are comparing functions expect_equal( diff --git a/tests/testthat/test-ansi-html.R b/tests/testthat/test-ansi-html.R index 4ea63cdb..f9dc8fe8 100644 --- a/tests/testthat/test-ansi-html.R +++ b/tests/testthat/test-ansi-html.R @@ -1,4 +1,3 @@ - test_that("ansi_html", { str <- c( "\033[1mbold\033[22m", diff --git a/tests/testthat/test-ansi-hyperlink.R b/tests/testthat/test-ansi-hyperlink.R index a9e68812..219b0b57 100644 --- a/tests/testthat/test-ansi-hyperlink.R +++ b/tests/testthat/test-ansi-hyperlink.R @@ -1,4 +1,3 @@ - test_that("ansi_align", { txt0 <- "\033]8;;https://ex.com\007te\033]8;;\007" txt1 <- st_from_bel(txt0) @@ -283,7 +282,8 @@ test_that("ansi_has_hyperlink_support", { local_clean_cli_context() # force with env var - withr::with_envvar(list(R_CLI_HYPERLINKS = "true"), + withr::with_envvar( + list(R_CLI_HYPERLINKS = "true"), expect_true(ansi_has_hyperlink_support()) ) @@ -523,7 +523,11 @@ test_that("construct_file_link() works with custom format and an absolute path", list(url = "positron://file/absolute/path:12") ) expect_equal( - construct_file_link(list(path = "/absolute/path", line = "12", column = "5")), + construct_file_link(list( + path = "/absolute/path", + line = "12", + column = "5" + )), list(url = "positron://file/absolute/path:12:5") ) @@ -552,41 +556,68 @@ test_that("construct_file_link() works with custom format and a relative path", } expect_equal( - sanitize_dir(construct_file_link(list(path = "relative/path")), what = "wd"), + sanitize_dir( + construct_file_link(list(path = "relative/path")), + what = "wd" + ), "positron://file/working/directory/relative/path" ) expect_equal( - sanitize_dir(construct_file_link(list(path = "relative/path:12")), what = "wd"), + sanitize_dir( + construct_file_link(list(path = "relative/path:12")), + what = "wd" + ), "positron://file/working/directory/relative/path:12" ) expect_equal( - sanitize_dir(construct_file_link(list(path = "relative/path:12:5")), what = "wd"), + sanitize_dir( + construct_file_link(list(path = "relative/path:12:5")), + what = "wd" + ), "positron://file/working/directory/relative/path:12:5" ) expect_equal( - sanitize_dir(construct_file_link(list(path = "./relative/path")), what = "wd"), + sanitize_dir( + construct_file_link(list(path = "./relative/path")), + what = "wd" + ), "positron://file/working/directory/./relative/path" ) expect_equal( - sanitize_dir(construct_file_link(list(path = "./relative/path:12")), what = "wd"), + sanitize_dir( + construct_file_link(list(path = "./relative/path:12")), + what = "wd" + ), "positron://file/working/directory/./relative/path:12" ) expect_equal( - sanitize_dir(construct_file_link(list(path = "./relative/path:12:5")), what = "wd"), + sanitize_dir( + construct_file_link(list(path = "./relative/path:12:5")), + what = "wd" + ), "positron://file/working/directory/./relative/path:12:5" ) expect_equal( - sanitize_dir(construct_file_link(list(path = "~/relative/path")), what = "home"), + sanitize_dir( + construct_file_link(list(path = "~/relative/path")), + what = "home" + ), "positron://file/my/home/relative/path" ) expect_equal( - sanitize_dir(construct_file_link(list(path = "~/relative/path:17")), what = "home"), + sanitize_dir( + construct_file_link(list(path = "~/relative/path:17")), + what = "home" + ), "positron://file/my/home/relative/path:17" ) expect_equal( - sanitize_dir(construct_file_link(list(path = "~/relative/path:17:22")), what = "home"), + sanitize_dir( + construct_file_link(list(path = "~/relative/path:17:22")), + what = "home" + ), "positron://file/my/home/relative/path:17:22" ) }) @@ -601,7 +632,11 @@ test_that("construct_file_link() works with custom format and input starting wit list(url = "positron://file/absolute/path") ) expect_equal( - construct_file_link(list(path = "file:///absolute/path", line = "12", column = "5")), + construct_file_link(list( + path = "file:///absolute/path", + line = "12", + column = "5" + )), list(url = "positron://file/absolute/path:12:5") ) }) diff --git a/tests/testthat/test-ansi-make.R b/tests/testthat/test-ansi-make.R index 3f0c02d0..a4696977 100644 --- a/tests/testthat/test-ansi-make.R +++ b/tests/testthat/test-ansi-make.R @@ -1,16 +1,32 @@ - test_that("make_style without name", { pink <- make_ansi_style("pink") expect_true(inherits(pink, "cli_ansi_style")) }) test_that("hexa color regex works", { - positive <- c("#000000", "#ffffff", "#0f0f0f", "#f0f0f0", - "#00000000", "#ffffffff", "#0f0f0f00", "#f0f0f055") + positive <- c( + "#000000", + "#ffffff", + "#0f0f0f", + "#f0f0f0", + "#00000000", + "#ffffffff", + "#0f0f0f00", + "#f0f0f055" + ) - negative <- c("", "#12345", "123456", "1234567", "12345678", - "#1234567", "#1234ffg", "#gggggx", "foo#123456", - "foo#123456bar") + negative <- c( + "", + "#12345", + "123456", + "1234567", + "12345678", + "#1234567", + "#1234ffg", + "#gggggx", + "foo#123456", + "foo#123456bar" + ) for (color in positive) { expect_true(grepl(hash_color_regex, color)) @@ -84,5 +100,5 @@ test_that("make_ansi_style", { expect_snapshot( error = TRUE, make_ansi_style("foobar") - ) + ) }) diff --git a/tests/testthat/test-ansi-palette.R b/tests/testthat/test-ansi-palette.R index 0cf256fe..415be07e 100644 --- a/tests/testthat/test-ansi-palette.R +++ b/tests/testthat/test-ansi-palette.R @@ -1,4 +1,3 @@ - test_that("ansi_palette_show", { local_clean_cli_context() expect_snapshot( diff --git a/tests/testthat/test-ansi-utils.R b/tests/testthat/test-ansi-utils.R index 69bd137b..aaa13ccd 100644 --- a/tests/testthat/test-ansi-utils.R +++ b/tests/testthat/test-ansi-utils.R @@ -1,4 +1,3 @@ - test_that("re_table", { withr::local_options( cli.num_colors = 256, diff --git a/tests/testthat/test-ansi.R b/tests/testthat/test-ansi.R index 943a6e0a..663dde62 100644 --- a/tests/testthat/test-ansi.R +++ b/tests/testthat/test-ansi.R @@ -1,6 +1,8 @@ - test_that("Classes", { - expect_equal(class(style_underline("foo")), c("cli_ansi_string", "ansi_string", "character")) + expect_equal( + class(style_underline("foo")), + c("cli_ansi_string", "ansi_string", "character") + ) }) test_that("Coloring and highlighting works", { @@ -15,11 +17,13 @@ test_that("Applying multiple styles at once works", { st <- combine_ansi_styles(col_red, bg_green, "underline") expect_equal( c(st("foo")), - "\u001b[31m\u001b[42m\u001b[4mfoo\u001b[24m\u001b[49m\u001b[39m") + "\u001b[31m\u001b[42m\u001b[4mfoo\u001b[24m\u001b[49m\u001b[39m" + ) st <- combine_ansi_styles(style_underline, "red", bg_green) expect_equal( c(st("foo")), - "\u001b[4m\u001b[31m\u001b[42mfoo\u001b[49m\u001b[39m\u001b[24m") + "\u001b[4m\u001b[31m\u001b[42mfoo\u001b[49m\u001b[39m\u001b[24m" + ) }) test_that("Nested styles are supported", { @@ -27,14 +31,16 @@ test_that("Nested styles are supported", { st <- combine_ansi_styles(style_underline, bg_blue) expect_equal( c(col_red("foo", st("bar"), "!")), - "\u001b[31mfoo\u001b[4m\u001b[44mbar\u001b[49m\u001b[24m!\u001b[39m") + "\u001b[31mfoo\u001b[4m\u001b[44mbar\u001b[49m\u001b[24m!\u001b[39m" + ) }) test_that("Nested styles of the same type are supported", { local_reproducible_output(crayon = TRUE) expect_equal( c(col_red("a", col_blue("b", col_green("c"), "b"), "c")), - "\u001b[31ma\u001b[34mb\u001b[32mc\u001b[34mb\u001b[31mc\u001b[39m") + "\u001b[31ma\u001b[34mb\u001b[32mc\u001b[34mb\u001b[31mc\u001b[39m" + ) }) test_that("Reset all styles", { @@ -44,9 +50,12 @@ test_that("Reset all styles", { paste0( "\033[0m\033[31m\033[42m\033[4mfoo\033[24m\033[49m\033[39m", "foo\033[0m\033[22m\033[23m\033[24m\033[27m\033[28m", - "\033[29m\033[39m\033[49m"), - paste0("\u001b[0m\u001b[31m\u001b[42m\u001b[4mfoo\u001b[24m\u001b[49m", - "\u001b[39mfoo\u001b[0m") + "\033[29m\033[39m\033[49m" + ), + paste0( + "\u001b[0m\u001b[31m\u001b[42m\u001b[4mfoo\u001b[24m\u001b[49m", + "\u001b[39mfoo\u001b[0m" + ) ) expect_true(style_reset(st("foo"), "foo") %in% ok) }) @@ -71,9 +80,9 @@ test_that("print.cli_ansi_string", { test_that("ansi-scale", { expect_snapshot({ - ansi_scale(c(0,0,0)) - ansi_scale(c(255,100,0)) - ansi_scale(c(255,100,0), round = FALSE) + ansi_scale(c(0, 0, 0)) + ansi_scale(c(255, 100, 0)) + ansi_scale(c(255, 100, 0), round = FALSE) }) }) diff --git a/tests/testthat/test-ansiex-2.R b/tests/testthat/test-ansiex-2.R index ce90d35c..a57e0ef8 100644 --- a/tests/testthat/test-ansiex-2.R +++ b/tests/testthat/test-ansiex-2.R @@ -1,4 +1,3 @@ - test_that("very long strings", { withr::local_options(cli.num_colors = 256) str <- strrep("1234 ", 1000) @@ -44,14 +43,14 @@ test_that("0m closing tag", { test_that("various tags", { cases <- list( - list("\033[1m\033[22m\033[1mfoo", "\033[1mfoo\033[22m"), - list("\033[2m\033[22m\033[2mfoo", "\033[2mfoo\033[22m"), - list("\033[3m\033[23m\033[3mfoo", "\033[3mfoo\033[23m"), - list("\033[4m\033[24m\033[4mfoo", "\033[4mfoo\033[24m"), - list("\033[5m\033[25m\033[5mfoo", "\033[5mfoo\033[25m"), - list("\033[7m\033[27m\033[7mfoo", "\033[7mfoo\033[27m"), - list("\033[8m\033[28m\033[8mfoo", "\033[8mfoo\033[28m"), - list("\033[9m\033[29m\033[9mfoo", "\033[9mfoo\033[29m"), + list("\033[1m\033[22m\033[1mfoo", "\033[1mfoo\033[22m"), + list("\033[2m\033[22m\033[2mfoo", "\033[2mfoo\033[22m"), + list("\033[3m\033[23m\033[3mfoo", "\033[3mfoo\033[23m"), + list("\033[4m\033[24m\033[4mfoo", "\033[4mfoo\033[24m"), + list("\033[5m\033[25m\033[5mfoo", "\033[5mfoo\033[25m"), + list("\033[7m\033[27m\033[7mfoo", "\033[7mfoo\033[27m"), + list("\033[8m\033[28m\033[8mfoo", "\033[8mfoo\033[28m"), + list("\033[9m\033[29m\033[9mfoo", "\033[9mfoo\033[29m"), list("\033[30m\033[39m\033[30mfoo", "\033[30mfoo\033[39m"), list("\033[31m\033[39m\033[31mfoo", "\033[31mfoo\033[39m"), list("\033[32m\033[39m\033[32mfoo", "\033[32mfoo\033[39m"), @@ -139,21 +138,21 @@ test_that("CSI sequences", { test_that("ansi_has_any", { T <- TRUE F <- FALSE - expect_false(ansi_has_any("foobar", sgr = T, csi = T)) - expect_true (ansi_has_any("\033[1mfoobar", sgr = T, csi = T)) - expect_true (ansi_has_any("\033[10Afoobar", sgr = T, csi = T)) - expect_true (ansi_has_any("\033[10A\033[1mfoobar", sgr = T, csi = T)) - expect_false(ansi_has_any("foobar", sgr = T, csi = F)) - expect_true (ansi_has_any("\033[1mfoobar", sgr = T, csi = F)) - expect_false(ansi_has_any("\033[10Afoobar", sgr = T, csi = F)) - expect_true (ansi_has_any("\033[10A\033[1mfoobar", sgr = T, csi = F)) - expect_false(ansi_has_any("foobar", sgr = F, csi = T)) - expect_false(ansi_has_any("\033[1mfoobar", sgr = F, csi = T)) - expect_true (ansi_has_any("\033[10Afoobar", sgr = F, csi = T)) - expect_true (ansi_has_any("\033[10A\033[1mfoobar", sgr = F, csi = T)) - expect_false(ansi_has_any("foobar", sgr = F, csi = F)) - expect_false(ansi_has_any("\033[1mfoobar", sgr = F, csi = F)) - expect_false(ansi_has_any("\033[10Afoobar", sgr = F, csi = F)) + expect_false(ansi_has_any("foobar", sgr = T, csi = T)) + expect_true(ansi_has_any("\033[1mfoobar", sgr = T, csi = T)) + expect_true(ansi_has_any("\033[10Afoobar", sgr = T, csi = T)) + expect_true(ansi_has_any("\033[10A\033[1mfoobar", sgr = T, csi = T)) + expect_false(ansi_has_any("foobar", sgr = T, csi = F)) + expect_true(ansi_has_any("\033[1mfoobar", sgr = T, csi = F)) + expect_false(ansi_has_any("\033[10Afoobar", sgr = T, csi = F)) + expect_true(ansi_has_any("\033[10A\033[1mfoobar", sgr = T, csi = F)) + expect_false(ansi_has_any("foobar", sgr = F, csi = T)) + expect_false(ansi_has_any("\033[1mfoobar", sgr = F, csi = T)) + expect_true(ansi_has_any("\033[10Afoobar", sgr = F, csi = T)) + expect_true(ansi_has_any("\033[10A\033[1mfoobar", sgr = F, csi = T)) + expect_false(ansi_has_any("foobar", sgr = F, csi = F)) + expect_false(ansi_has_any("\033[1mfoobar", sgr = F, csi = F)) + expect_false(ansi_has_any("\033[10Afoobar", sgr = F, csi = F)) expect_false(ansi_has_any("\033[10A\033[1mfoobar", sgr = F, csi = F)) }) diff --git a/tests/testthat/test-ansiex.R b/tests/testthat/test-ansiex.R index 842942e8..c87672db 100644 --- a/tests/testthat/test-ansiex.R +++ b/tests/testthat/test-ansiex.R @@ -1,4 +1,3 @@ - test_that("cli_ansi_string", { right <- c("cli_ansi_string", "ansi_string", "character") expect_equal(class(ansi_string("foobar")), right) @@ -54,14 +53,16 @@ test_that("ansi_strip works", { } }) -str <- c("", - "plain", - "\033[31m", - "\033[39m", - "\033[31mred\033[39m", - "\033[31mred\033[39m\033[31mred\033[39m", - "foo\033[31mred\033[39m", - "\033[31mred\033[39mfoo") +str <- c( + "", + "plain", + "\033[31m", + "\033[39m", + "\033[31mred\033[39m", + "\033[31mred\033[39m\033[31mred\033[39m", + "foo\033[31mred\033[39m", + "\033[31mred\033[39mfoo" +) test_that("ansi_nchar", { withr::local_options(list(cli.num_colors = 256L)) @@ -94,8 +95,11 @@ test_that("ansi_substr", { for (s in str) { for (i in 1 %:% ansi_nchar(s)) { for (j in i %:% ansi_nchar(s)) { - expect_equal(ansi_strip(ansi_substr(s, i, j)), - substr(ansi_strip(s), i, j), info = paste(s, i, j)) + expect_equal( + ansi_strip(ansi_substr(s, i, j)), + substr(ansi_strip(s), i, j), + info = paste(s, i, j) + ) } } } @@ -154,8 +158,8 @@ test_that("ansi_substr corner cases", { # Zero length input c0 <- character(0L) - o0 <- structure(list(), class="abc") - co0 <- structure(character(0L), class="abc") + o0 <- structure(list(), class = "abc") + co0 <- structure(character(0L), class = "abc") expect_identical(ansi_substr(c0, 1, 1), ansi_string(substr(c0, 1, 1))) expect_identical(ansi_substr(o0, 1, 1), ansi_string(substr(o0, 1, 1))) expect_identical(ansi_substr(co0, 1, 1), ansi_string(substr(co0, 1, 1))) @@ -196,8 +200,11 @@ test_that("ansi_substring", { for (s in str) { for (i in 1 %:% ansi_nchar(s)) { for (j in i %:% ansi_nchar(s)) { - expect_equal(ansi_strip(ansi_substring(s, i, j)), - substring(ansi_strip(s), i, j), info = paste(s, i, j)) + expect_equal( + ansi_strip(ansi_substring(s, i, j)), + substring(ansi_strip(s), i, j), + info = paste(s, i, j) + ) } } } @@ -223,8 +230,8 @@ test_that("ansi_substring corner cases", { # Zero length input c0 <- character(0L) - o0 <- structure(list(), class="abc") - co0 <- structure(character(0L), class="abc") + o0 <- structure(list(), class = "abc") + co0 <- structure(character(0L), class = "abc") expect_identical( ansi_substring(c0, 1, 1), ansi_string(substring(c0, 1, 1)) @@ -268,13 +275,17 @@ test_that("ansi_strsplit", { # with leading and trailing separators str.2 <- paste0("-", red, "-", red, "-", red, "-") - expect_equal(ansi_strip(ansi_strsplit(str.2, "-")[[1]]), - strsplit(ansi_strip(str.2), "-")[[1]]) + expect_equal( + ansi_strip(ansi_strsplit(str.2, "-")[[1]]), + strsplit(ansi_strip(str.2), "-")[[1]] + ) # greater than length 1 str.3 <- paste0("-", c(col_green("hello"), col_red("goodbye")), "-world-") - expect_equal(ansi_strip(unlist(ansi_strsplit(str.3, "-"))), - unlist(strsplit(ansi_strip(str.3), "-"))) + expect_equal( + ansi_strip(unlist(ansi_strsplit(str.3, "-"))), + unlist(strsplit(ansi_strip(str.3), "-")) + ) }) test_that("ansi_strsplit multiple strings", { @@ -295,7 +306,8 @@ test_that("ansi_strsplit edge cases", { withr::local_options(list(cli.num_colors = 256L)) expect_equal(ansi_strsplit("", "-"), list(ansi_string(character(0L)))) expect_equal( - ansi_strip(ansi_strsplit("\033[31m\033[39m", "-")[[1]]), character(0L) + ansi_strip(ansi_strsplit("\033[31m\033[39m", "-")[[1]]), + character(0L) ) # special cases @@ -366,28 +378,34 @@ test_that("ansi_align", { expect_equal( ansi_align(c("foo", "foobar", "", "a"), 6, "left"), - ansi_string(c("foo ", "foobar", " ", "a "))) + ansi_string(c("foo ", "foobar", " ", "a ")) + ) expect_equal( ansi_align(c("foo", "foobar", "", "a"), 6, "center"), - ansi_string(c(" foo ", "foobar", " ", " a "))) + ansi_string(c(" foo ", "foobar", " ", " a ")) + ) expect_equal( ansi_align(c("foo", "foobar", "", "a"), 6, "right"), - ansi_string(c(" foo", "foobar", " ", " a"))) + ansi_string(c(" foo", "foobar", " ", " a")) + ) # #54: alignment of wide characters expect_equal( ansi_align(c("foo", "\u6210\u4ea4\u65e5", "", "a"), 6, "left"), - ansi_string(c("foo ", "\u6210\u4ea4\u65e5", " ", "a "))) + ansi_string(c("foo ", "\u6210\u4ea4\u65e5", " ", "a ")) + ) expect_equal( ansi_align(c("foo", "\u6210\u4ea4\u65e5", "", "a"), 6, "center"), - ansi_string(c(" foo ", "\u6210\u4ea4\u65e5", " ", " a "))) + ansi_string(c(" foo ", "\u6210\u4ea4\u65e5", " ", " a ")) + ) expect_equal( ansi_align(c("foo", "\u6210\u4ea4\u65e5", "", "a"), 6, "right"), - ansi_string(c(" foo", "\u6210\u4ea4\u65e5", " ", " a"))) + ansi_string(c(" foo", "\u6210\u4ea4\u65e5", " ", " a")) + ) }) test_that("stripping hyperlinks", { @@ -410,7 +428,8 @@ test_that("ansi_trimws", { list(col_red(c(" colored ")), ansi_string(col_red("colored"))), list( paste0(" ", col_red(c(" colored ")), " "), - ansi_string(col_red("colored"))) + ansi_string(col_red("colored")) + ) ) for (case in cases) expect_equal(ansi_trimws(case[[1]]), case[[2]]) @@ -425,7 +444,8 @@ test_that("ansi_trimws", { list(col_red(c(" colored ")), ansi_string(col_red("colored "))), list( paste0(" ", col_red(c(" colored ")), " "), - ansi_string(paste0(col_red("colored "), " "))) + ansi_string(paste0(col_red("colored "), " ")) + ) ) for (case in cases_left) { @@ -443,7 +463,8 @@ test_that("ansi_trimws", { list(col_red(c(" colored ")), ansi_string(col_red(" colored"))), list( paste0(" ", col_red(c(" colored ")), " "), - ansi_string(paste0(" ", col_red(" colored")))) + ansi_string(paste0(" ", col_red(" colored"))) + ) ) for (case in cases_right) { @@ -481,13 +502,15 @@ test_that("ansi_strwrap simple styled", { }) test_that("ansi_strwrap", { - txt0 <- glue::glue_col(" + txt0 <- glue::glue_col( + " {col_red Velit occaecat} quis culpa occaecat. {col_green Pariatur} \\ ad veniam pariatur {bg_blue consectetur}. Dolore aliquip et \\ {style_underline consequat Lorem consectetur} dolor. Irure id velit \\ proident elit veniam eu exercitation nisi laboris officia. Qui \\ {col_red sunt occaecat} cillum {col_red sit commodo sit. \\ - Culpa} aliquip et consectetur ullamco aliqua Lorem laborum dolore. ") + Culpa} aliquip et consectetur ullamco aliqua Lorem laborum dolore. " + ) txt <- paste0(txt0, "\n\t \n", txt0) expect_equal( @@ -548,9 +571,13 @@ test_that_cli(configs = c("plain", "ansi"), "ansi_strtrim", { list("12345678901", ansi_string("1234567...")), list( strrep("\u231A", 6), - ansi_string(paste0(strrep("\u231A", 3), "..."))), + ansi_string(paste0(strrep("\u231A", 3), "...")) + ), list(col_red("1"), col_red("1")), - list(c("foo", NA, col_red("bar")), ansi_string(c("foo", NA, col_red("bar")))) + list( + c("foo", NA, col_red("bar")), + ansi_string(c("foo", NA, col_red("bar"))) + ) ) for (case in cases) expect_equal(ansi_strtrim(case[[1]], 10), case[[2]]) diff --git a/tests/testthat/test-app.R b/tests/testthat/test-app.R index 37da34e0..dfcdace2 100644 --- a/tests/testthat/test-app.R +++ b/tests/testthat/test-app.R @@ -1,4 +1,3 @@ - test_that("stop_app() errors", { expect_snapshot( error = TRUE, diff --git a/tests/testthat/test-assertions.R b/tests/testthat/test-assertions.R index e9ed5dfe..26f08252 100644 --- a/tests/testthat/test-assertions.R +++ b/tests/testthat/test-assertions.R @@ -1,9 +1,14 @@ - test_that("is_string", { - strings <- list("foo", "", "111", "1", "-", "NA") - not_strings <- list(1, character(), NA_character_, NA, - c("foo", NA), c("1", "2"), NULL) + not_strings <- list( + 1, + character(), + NA_character_, + NA, + c("foo", NA), + c("1", "2"), + NULL + ) for (p in strings) { expect_true(is_string(p)) @@ -33,10 +38,21 @@ test_that("is_border_style", { }) test_that("is_padding_or_margin", { - good <- list(1, 0, 0L, 1L, 237, c(1,2,3,4), c(0,0,0,0), rep(1L, 4)) - bad <- list(numeric(), integer(), c(1,2), c(1L, 2L, 3L), 1:5, - "1", c("1", "2", "3", "1"), NA, NA_real_, NA_integer_, - c(1,2,NA,1), c(1L,NA,3L)) + good <- list(1, 0, 0L, 1L, 237, c(1, 2, 3, 4), c(0, 0, 0, 0), rep(1L, 4)) + bad <- list( + numeric(), + integer(), + c(1, 2), + c(1L, 2L, 3L), + 1:5, + "1", + c("1", "2", "3", "1"), + NA, + NA_real_, + NA_integer_, + c(1, 2, NA, 1), + c(1L, NA, 3L) + ) for (g in good) { expect_true(is_padding_or_margin(g)) @@ -71,10 +87,17 @@ test_that("is_col", { }) test_that("is_count", { - counts <- list(1, 1L, 0, 0L, 42, 42L) - not_counts <- list(c(1, 2), numeric(), NA_integer_, NA_real_, NA, 1.1, - NULL, "1") + not_counts <- list( + c(1, 2), + numeric(), + NA_integer_, + NA_real_, + NA, + 1.1, + NULL, + "1" + ) for (c in counts) { expect_true(is_count(c)) @@ -108,6 +131,6 @@ test_that("is_tree_style", { list("1", "2", "3", "4") ) - for (x in good) expect_true (is_tree_style(x)) - for (x in bad ) expect_false(is_tree_style(x)) + for (x in good) expect_true(is_tree_style(x)) + for (x in bad) expect_false(is_tree_style(x)) }) diff --git a/tests/testthat/test-box-styles.R b/tests/testthat/test-box-styles.R index e3c55b50..e8cfdc3d 100644 --- a/tests/testthat/test-box-styles.R +++ b/tests/testthat/test-box-styles.R @@ -1,4 +1,3 @@ - test_that_cli(configs = c("plain", "unicode"), "list_border_styles", { expect_snapshot( for (st in list_border_styles()) print(boxx("", border_style = st)) diff --git a/tests/testthat/test-boxes.R b/tests/testthat/test-boxes.R index ecd23b29..7d3034eb 100644 --- a/tests/testthat/test-boxes.R +++ b/tests/testthat/test-boxes.R @@ -1,4 +1,3 @@ - test_that_cli(configs = c("plain", "unicode"), "empty label", { expect_snapshot(boxx("")) }) @@ -21,15 +20,15 @@ test_that_cli(configs = c("plain", "unicode"), "border style", { test_that_cli(configs = c("plain", "unicode"), "padding", { expect_snapshot(boxx("label", padding = 2)) - expect_snapshot(boxx("label", padding = c(1,2,1,2))) - expect_snapshot(boxx("label", padding = c(1,2,0,2))) - expect_snapshot(boxx("label", padding = c(1,2,0,0))) + expect_snapshot(boxx("label", padding = c(1, 2, 1, 2))) + expect_snapshot(boxx("label", padding = c(1, 2, 0, 2))) + expect_snapshot(boxx("label", padding = c(1, 2, 0, 0))) }) test_that_cli(configs = c("plain", "unicode"), "margin", { expect_snapshot(boxx("label", margin = 1)) - expect_snapshot(boxx("label", margin = c(1,2,3,4))) - expect_snapshot(boxx("label", margin = c(0,1,2,0))) + expect_snapshot(boxx("label", margin = c(1, 2, 3, 4))) + expect_snapshot(boxx("label", margin = c(0, 1, 2, 0))) }) test_that_cli(configs = c("plain", "unicode"), "float", { diff --git a/tests/testthat/test-bullets.R b/tests/testthat/test-bullets.R index 6d95ee2f..dfc29199 100644 --- a/tests/testthat/test-bullets.R +++ b/tests/testthat/test-bullets.R @@ -1,10 +1,9 @@ - start_app() on.exit(stop_app(), add = TRUE) test_that_cli("bullets", { expect_snapshot(cli_bullets(c( - "noindent", + "noindent", " " = "space", "v" = "success", "x" = "danger", @@ -17,7 +16,7 @@ test_that_cli("bullets", { test_that_cli("bullets glue", { expect_snapshot(cli_bullets(c( - "noindent {.key {1:3}}", + "noindent {.key {1:3}}", " " = "space {.key {1:3}}", "v" = "success {.key {1:3}}", "x" = "danger {.key {1:3}}", diff --git a/tests/testthat/test-cat-helpers.R b/tests/testthat/test-cat-helpers.R index 072a425d..7ea8d236 100644 --- a/tests/testthat/test-cat-helpers.R +++ b/tests/testthat/test-cat-helpers.R @@ -1,4 +1,3 @@ - test_that("cat_line", { expect_snapshot( cat_line("This is ", "a ", "line of text.") diff --git a/tests/testthat/test-cat.R b/tests/testthat/test-cat.R index 8d530974..c8550fe7 100644 --- a/tests/testthat/test-cat.R +++ b/tests/testthat/test-cat.R @@ -1,4 +1,3 @@ - test_that("cat_line appends to file", { tmp <- tempfile() cat_line("a", file = tmp) diff --git a/tests/testthat/test-cliapp-output.R b/tests/testthat/test-cliapp-output.R index a296e0ea..f9dd44ae 100644 --- a/tests/testthat/test-cliapp-output.R +++ b/tests/testthat/test-cliapp-output.R @@ -1,4 +1,3 @@ - start_app() on.exit(stop_app(), add = TRUE) diff --git a/tests/testthat/test-code.R b/tests/testthat/test-code.R index 45a3fe95..b7336f15 100644 --- a/tests/testthat/test-code.R +++ b/tests/testthat/test-code.R @@ -1,4 +1,3 @@ - start_app() on.exit(stop_app(), add = TRUE) diff --git a/tests/testthat/test-collapsing.R b/tests/testthat/test-collapsing.R index 156412e7..0ae11c2b 100644 --- a/tests/testthat/test-collapsing.R +++ b/tests/testthat/test-collapsing.R @@ -1,4 +1,3 @@ - start_app() on.exit(stop_app(), add = TRUE) @@ -42,16 +41,20 @@ test_that("collapsing a cli_vec", { }) }) -test_that_cli(configs = c("plain", "ansi"), "collapsing a cli_vec with styling", { - expect_snapshot(local({ - cli_div(theme = list(body = list("vec-sep" = " ... "))) - pkgs <- cli_vec( - paste0("pkg", 1:5), - style = list("vec-sep" = " & ", "vec-last" = " & ", color = "blue") - ) - cli_text("Packages: {pkgs}.") - })) -}) +test_that_cli( + configs = c("plain", "ansi"), + "collapsing a cli_vec with styling", + { + expect_snapshot(local({ + cli_div(theme = list(body = list("vec-sep" = " ... "))) + pkgs <- cli_vec( + paste0("pkg", 1:5), + style = list("vec-sep" = " & ", "vec-last" = " & ", color = "blue") + ) + cli_text("Packages: {pkgs}.") + })) + } +) test_that("head", { v <- function(n, t = 5) { @@ -187,15 +190,15 @@ test_that("ansi_collapse with width trimming", { }) test_that("ansi_collapse produces consistent truncation results", { - expect_equal(ansi_collapse(1:2, trunc = 1, style = "head"), - ansi_collapse(1:2, trunc = 0, style = "head")) + expect_equal( + ansi_collapse(1:2, trunc = 1, style = "head"), + ansi_collapse(1:2, trunc = 0, style = "head") + ) }) test_that("ansi_collapse uses `sep2` for length-two inputs", { - expect_equal(ansi_collapse(1:2), - "1 and 2") - expect_equal(ansi_collapse(1:2, trunc = 2, style = "head"), - "1 and 2") + expect_equal(ansi_collapse(1:2), "1 and 2") + expect_equal(ansi_collapse(1:2, trunc = 2, style = "head"), "1 and 2") }) test_that("Avoid duplication of length 1 vecs when width set (#590)", { @@ -203,7 +206,10 @@ test_that("Avoid duplication of length 1 vecs when width set (#590)", { expect_equal(ansi_collapse(1, style = "head"), "1") expect_equal(ansi_collapse(1, style = "head", width = 70), "1") expect_equal(ansi_collapse(1, style = "head", last = " and again "), "1") - expect_equal(ansi_collapse(1, style = "head", width = 70, last = " and again "), "1") + expect_equal( + ansi_collapse(1, style = "head", width = 70, last = " and again "), + "1" + ) }) test_that("Issue #681", { diff --git a/tests/testthat/test-console-width.R b/tests/testthat/test-console-width.R index aea6231a..963754ef 100644 --- a/tests/testthat/test-console-width.R +++ b/tests/testthat/test-console-width.R @@ -1,4 +1,3 @@ - test_that("errors", { withr::local_options(cli.width = letters) expect_snapshot_error( diff --git a/tests/testthat/test-containers.R b/tests/testthat/test-containers.R index 140f4f4f..92c11ad3 100644 --- a/tests/testthat/test-containers.R +++ b/tests/testthat/test-containers.R @@ -1,4 +1,3 @@ - start_app() on.exit(stop_app(), add = TRUE) @@ -102,8 +101,9 @@ test_that("before and after work properly", { expect_snapshot(local({ cli_div( theme = list( - "div.alert-success" = list(before ="!!!") - )) + "div.alert-success" = list(before = "!!!") + ) + ) cli_alert_success("{.pkg foobar} is good") })) }) diff --git a/tests/testthat/test-css.R b/tests/testthat/test-css.R index b5a706bb..4a44afe2 100644 --- a/tests/testthat/test-css.R +++ b/tests/testthat/test-css.R @@ -1,6 +1,4 @@ - test_that("parse_selector_node", { - empty <- list(tag = character(), class = character(), id = character()) cases <- list( @@ -25,19 +23,25 @@ test_that("parse_selector_node", { }) test_that("parse_selector", { - empty <- list(tag = character(), class = character(), id = character()) cases <- list( list("", list()), list("foo", list(list(tag = "foo"))), list("foo bar", list(list(tag = "foo"), list(tag = "bar"))), - list("foo.c1 bar.c2", - list(list(tag = "foo", class = "c1"), - list(tag = "bar", class = "c2"))), - list("#i1 tag #i2 .cl", - list(list(id = "i1"), list(tag = "tag"), list(id = "i2"), - list(class = "cl"))) + list( + "foo.c1 bar.c2", + list(list(tag = "foo", class = "c1"), list(tag = "bar", class = "c2")) + ), + list( + "#i1 tag #i2 .cl", + list( + list(id = "i1"), + list(tag = "tag"), + list(id = "i2"), + list(class = "cl") + ) + ) ) for (c in cases) { @@ -47,7 +51,6 @@ test_that("parse_selector", { }) test_that("match_selector_node", { - default <- list(tag = "mytag", class = character(), id = "myid") pos <- list( @@ -77,19 +80,16 @@ test_that("match_selector_node", { cnt <- modifyList(default, c[[2]]) expect_false(match_selector_node(sel, cnt), info = c[[1]]) } - }) test_that("match_selector", { - default <- list(tag = "mytag", class = character(), id = "myid") pos <- list( list("foo bar", list(list(tag = "foo"), list(tag = "bar"))), list("bar", list(list(tag = "foo"), list(tag = "bar"))), list(".class", list(list(tag = "x"), list(class = "class"))), - list(".c1", - list(list(tag = "x"), list(class = "c"), list(class = "c1"))) + list(".c1", list(list(tag = "x"), list(class = "c"), list(class = "c1"))) ) for (c in pos) { @@ -97,7 +97,7 @@ test_that("match_selector", { cnts <- lapply(c[[2]], function(x) modifyList(default, x)) expect_true(match_selector(sels, cnts), info = c[[1]]) } - + neg <- list( list("foo bar", list(list(tag = "foo"), list(tag = "ba"))), list("foo bar", list(list(tag = "foo"), list(class = "bar"))), diff --git a/tests/testthat/test-custom-handler.R b/tests/testthat/test-custom-handler.R index 2e7f910f..f80a97ec 100644 --- a/tests/testthat/test-custom-handler.R +++ b/tests/testthat/test-custom-handler.R @@ -1,9 +1,12 @@ - test_that("custom handler works", { conds <- list() withr::with_options( list(cli.default_handler = function(msg) conds <<- c(conds, list(msg))), - { cli_h1("title"); cli_h2("subtitle"); cli_text("text") } + { + cli_h1("title") + cli_h2("subtitle") + cli_text("text") + } ) expect_equal(length(conds), 3) lapply(conds, expect_s3_class, "cli_message") diff --git a/tests/testthat/test-deep-lists.R b/tests/testthat/test-deep-lists.R index a5bb9d09..1baa6f71 100644 --- a/tests/testthat/test-deep-lists.R +++ b/tests/testthat/test-deep-lists.R @@ -1,12 +1,11 @@ - start_app() on.exit(stop_app(), add = TRUE) test_that("deep lists ul", { test_ul = function(n = 2) { - for(i in seq_len(n)) { + for (i in seq_len(n)) { cli::cli_ul() - cli::cli_li(paste0("Level ",i)) + cli::cli_li(paste0("Level ", i)) } } expect_snapshot( @@ -16,9 +15,9 @@ test_that("deep lists ul", { test_that("deep lists ol", { test_ol = function(n = 2) { - for(i in seq_len(n)) { + for (i in seq_len(n)) { cli::cli_ol() - cli::cli_li(paste0("Level ",i)) + cli::cli_li(paste0("Level ", i)) } } expect_snapshot( @@ -28,12 +27,12 @@ test_that("deep lists ol", { test_that("deep lists ol ul", { test_ol_ul = function(n = 2) { - for(i in seq_len(n)) { + for (i in seq_len(n)) { cli::cli_ol() - cli::cli_li(paste0("Level ",2*i-1)) + cli::cli_li(paste0("Level ", 2 * i - 1)) cli::cli_ul() - cli::cli_li(paste0("Level ",2*i)) + cli::cli_li(paste0("Level ", 2 * i)) } } expect_snapshot( @@ -43,12 +42,12 @@ test_that("deep lists ol ul", { test_that("deep lists ul ol", { test_ul_ol = function(n = 2) { - for(i in seq_len(n)) { + for (i in seq_len(n)) { cli::cli_ul() - cli::cli_li(paste0("Level ",2*i-1)) + cli::cli_li(paste0("Level ", 2 * i - 1)) cli::cli_ol() - cli::cli_li(paste0("Level ",2*i)) + cli::cli_li(paste0("Level ", 2 * i)) } } expect_snapshot( diff --git a/tests/testthat/test-defer.R b/tests/testthat/test-defer.R index b47a7955..9af324dc 100644 --- a/tests/testthat/test-defer.R +++ b/tests/testthat/test-defer.R @@ -1,4 +1,3 @@ - test_that("errors", { fun <- function() { defer(1 + "") diff --git a/tests/testthat/test-diff.R b/tests/testthat/test-diff.R index 482973a0..4243f9d9 100644 --- a/tests/testthat/test-diff.R +++ b/tests/testthat/test-diff.R @@ -1,8 +1,7 @@ - test_that("diff_chr", { # Something simple first - a <- as.character(c(1,1,1,1,1,1,1,2,3,4,4,4,4,4,4,4,5)) - b <- as.character(c(1,1,1,1,1,1,1,2,10,4,4,4,4,4,4,4,6,7,5)) + a <- as.character(c(1, 1, 1, 1, 1, 1, 1, 2, 3, 4, 4, 4, 4, 4, 4, 4, 5)) + b <- as.character(c(1, 1, 1, 1, 1, 1, 1, 2, 10, 4, 4, 4, 4, 4, 4, 4, 6, 7, 5)) d <- diff_chr(a, b) expect_snapshot(d$lcs) d <- diff_chr(b, a) @@ -11,8 +10,8 @@ test_that("diff_chr", { test_that_cli(configs = c("plain", "ansi"), "diff_chr", { # Something simple first - a <- as.character(c(1,1,1,1,1,1,1,2,3,4,4,4,4,4,4,4,5)) - b <- as.character(c(1,1,1,1,1,1,1,2,10,4,4,4,4,4,4,4,6,7,5)) + a <- as.character(c(1, 1, 1, 1, 1, 1, 1, 2, 3, 4, 4, 4, 4, 4, 4, 4, 5)) + b <- as.character(c(1, 1, 1, 1, 1, 1, 1, 2, 10, 4, 4, 4, 4, 4, 4, 4, 6, 7, 5)) d <- diff_chr(a, b) expect_snapshot(d) expect_snapshot(d$lcs) @@ -31,8 +30,8 @@ test_that("diff_chr edge cases", { test_that("format.cli_diff_chr context", { # Something simple first - a <- as.character(c(1,1,1,1,1,1,1,2,3,4,4,4,4,4,4,4,5)) - b <- as.character(c(1,1,1,1,1,1,1,2,10,4,4,4,4,4,4,4,6,7,5)) + a <- as.character(c(1, 1, 1, 1, 1, 1, 1, 2, 3, 4, 4, 4, 4, 4, 4, 4, 5)) + b <- as.character(c(1, 1, 1, 1, 1, 1, 1, 2, 10, 4, 4, 4, 4, 4, 4, 4, 6, 7, 5)) d <- diff_chr(a, b) expect_snapshot(print(d, context = 1)) expect_snapshot(print(d, context = 0)) diff --git a/tests/testthat/test-format-conditions.R b/tests/testthat/test-format-conditions.R index 9056d554..5da48eff 100644 --- a/tests/testthat/test-format-conditions.R +++ b/tests/testthat/test-format-conditions.R @@ -1,29 +1,34 @@ - test_that_cli("format_error", { - expect_snapshot(error = TRUE, local({ - n <- "boo" - stop(format_error(c( - "{.var n} must be a numeric vector", - "x" = "You've supplied a {.cls {class(n)}} vector." - ))) - })) + expect_snapshot( + error = TRUE, + local({ + n <- "boo" + stop(format_error(c( + "{.var n} must be a numeric vector", + "x" = "You've supplied a {.cls {class(n)}} vector." + ))) + }) + ) - expect_snapshot(error = TRUE, local({ - len <- 26 - idx <- 100 - stop(format_error(c( - "Must index an existing element:", - "i" = "There {?is/are} {len} element{?s}.", - "x" = "You've tried to subset element {idx}." - ))) - })) + expect_snapshot( + error = TRUE, + local({ + len <- 26 + idx <- 100 + stop(format_error(c( + "Must index an existing element:", + "i" = "There {?is/are} {len} element{?s}.", + "x" = "You've tried to subset element {idx}." + ))) + }) + ) }) test_that_cli("format_warning", { expect_snapshot({ n <- "boo" warning(format_warning(c( - "{.var n} must be a numeric vector", + "{.var n} must be a numeric vector", "x" = "You've supplied a {.cls {class(n)}} vector." ))) }) @@ -32,7 +37,7 @@ test_that_cli("format_warning", { len <- 26 idx <- 100 warning(format_warning(c( - "Must index an existing element:", + "Must index an existing element:", "i" = "There {?is/are} {len} element{?s}.", "x" = "You've tried to subset element {idx}." ))) @@ -43,7 +48,7 @@ test_that_cli("format_message", { expect_snapshot({ n <- "boo" message(format_message(c( - "{.var n} must be a numeric vector", + "{.var n} must be a numeric vector", "x" = "You've supplied a {.cls {class(n)}} vector." ))) }) @@ -52,7 +57,7 @@ test_that_cli("format_message", { len <- 26 idx <- 100 message(format_message(c( - "Must index an existing element:", + "Must index an existing element:", "i" = "There {?is/are} {len} element{?s}.", "x" = "You've tried to subset element {idx}." ))) @@ -61,7 +66,8 @@ test_that_cli("format_message", { test_that_cli(configs = "ansi", "color in RStudio", { local_mocked_bindings( - rstudio_detect = function() list(type = "rstudio_console", num_colors = 256), + rstudio_detect = function() + list(type = "rstudio_console", num_colors = 256), get_rstudio_theme = function() list(foreground = "rgb(0, 0, 0)") ) expect_snapshot({ @@ -96,11 +102,14 @@ test_that("named first element", { test_that("no cli conditions are thrown", { cnd <- NULL - withCallingHandlers({ - format_error("error") - format_warning("warning") - format_message("message") - }, cli_message = function(cnd_) cnd <<- cnd_) + withCallingHandlers( + { + format_error("error") + format_warning("warning") + format_message("message") + }, + cli_message = function(cnd_) cnd <<- cnd_ + ) expect_null(cnd) }) @@ -124,17 +133,20 @@ test_that("cli.condition_width", { test_that_cli("suppressing Unicode bullets", { withr::local_options(cli.condition_unicode_bullets = FALSE) - expect_snapshot(error = TRUE, local({ - n <- "boo" - stop(format_error(c( - "{.var n} must be a numeric vector", - "x" = "You've supplied a {.cls {class(n)}} vector.", - "v" = "Success.", - "i" = "Info.", - "*" = "Bullet", - ">" = "Arrow" - ))) - })) + expect_snapshot( + error = TRUE, + local({ + n <- "boo" + stop(format_error(c( + "{.var n} must be a numeric vector", + "x" = "You've supplied a {.cls {class(n)}} vector.", + "v" = "Success.", + "i" = "Info.", + "*" = "Bullet", + ">" = "Arrow" + ))) + }) + ) }) test_that("edge cases", { diff --git a/tests/testthat/test-glue.R b/tests/testthat/test-glue.R index 1ffaa0ad..dc624be2 100644 --- a/tests/testthat/test-glue.R +++ b/tests/testthat/test-glue.R @@ -1,4 +1,3 @@ - # https://github.com/r-lib/cli/issues/370 test_that("glue quotes and comments", { diff --git a/tests/testthat/test-hash.R b/tests/testthat/test-hash.R index d9b5a6ba..92d90cf7 100644 --- a/tests/testthat/test-hash.R +++ b/tests/testthat/test-hash.R @@ -1,4 +1,3 @@ - test_that("hash_sha256", { dig <- function(x) { digest::digest(x, serialize = FALSE, algo = "sha256") diff --git a/tests/testthat/test-headers.R b/tests/testthat/test-headers.R index 52138ec2..98bcef2b 100644 --- a/tests/testthat/test-headers.R +++ b/tests/testthat/test-headers.R @@ -1,22 +1,27 @@ - start_app() on.exit(stop_app(), add = TRUE) test_that_cli("headers", { - expect_snapshot(local({ - cli_div(class = "testcli", theme = test_style()) - cli_h1("HEADER") - cli_h2("Header") - cli_h3("Header") - x <- "foobar" - xx <- 100 - cli_h2("{xx}. header: {x}") - }), variant = if (packageVersion("testthat") <= "3.1.4") "old" else "new") + expect_snapshot( + local({ + cli_div(class = "testcli", theme = test_style()) + cli_h1("HEADER") + cli_h2("Header") + cli_h3("Header") + x <- "foobar" + xx <- 100 + cli_h2("{xx}. header: {x}") + }), + variant = if (packageVersion("testthat") <= "3.1.4") "old" else "new" + ) }) test_that("issue #218", { - expect_snapshot({ - cli_h1("one {1} two {2} three {3}") - cli_h2("one {1} two {2} three {3}") - }, variant = if (packageVersion("testthat") <= "3.1.4") "old" else "new") + expect_snapshot( + { + cli_h1("one {1} two {2} three {3}") + cli_h2("one {1} two {2} three {3}") + }, + variant = if (packageVersion("testthat") <= "3.1.4") "old" else "new" + ) }) diff --git a/tests/testthat/test-inline-2.R b/tests/testthat/test-inline-2.R index 00c642d4..e4c2bf44 100644 --- a/tests/testthat/test-inline-2.R +++ b/tests/testthat/test-inline-2.R @@ -1,11 +1,10 @@ - start_app() on.exit(stop_app(), add = TRUE) test_that_cli( configs = c("plain", "ansi"), - "quoting phrases that don't start or end with letter or number", { - + "quoting phrases that don't start or end with letter or number", + { expect_snapshot(local({ x0 <- "good-name" cli_text("The name is {.file {x0}}.") @@ -67,7 +66,7 @@ test_that_cli(configs = c("plain", "ansi"), "transform", { test_that("cli_format", { expect_snapshot( - cli_format(1:4/7, list(digits = 2)) + cli_format(1:4 / 7, list(digits = 2)) ) }) @@ -108,10 +107,12 @@ test_that("line breaks", { test_that_cli(configs = "ansi", "double ticks", { x <- c("a", "`x`", "b") - cli_div(theme = list( - .code = list(color = "red"), - .fun = list(color = "red") - )) + cli_div( + theme = list( + .code = list(color = "red"), + .fun = list(color = "red") + ) + ) expect_snapshot(format_inline("{.code {x}}")) expect_snapshot(format_inline("{.fun {x}}")) }) diff --git a/tests/testthat/test-inline.R b/tests/testthat/test-inline.R index 95d6d9c5..57692972 100644 --- a/tests/testthat/test-inline.R +++ b/tests/testthat/test-inline.R @@ -1,4 +1,3 @@ - withr::local_envvar(CLI_NO_BUILTIN_THEME = "true") withr::local_options(cli.theme = NULL, cli.user_theme = NULL) start_app() @@ -6,16 +5,29 @@ on.exit(stop_app(), add = TRUE) test_that_cli(configs = c("plain", "ansi"), "inline classes", { classes <- c( - "emph", "strong", "code", "pkg", "fun", "arg", "key", "file", "path", - "email", "url", "var", "envvar", "cls") + "emph", + "strong", + "code", + "pkg", + "fun", + "arg", + "key", + "file", + "path", + "email", + "url", + "var", + "envvar", + "cls" + ) do <- function(class) { - special_style <- structure( list( list(color = "cyan"), list(before = "<<<"), - list(after =">>>")), + list(after = ">>>") + ), names = c( paste0("span.", class), paste0("span.", class), @@ -24,8 +36,7 @@ test_that_cli(configs = c("plain", "ansi"), "inline classes", { ) cli_div(theme = special_style) - txt <- glue::glue("This is {. it} really", - .open = "<", .close = ">") + txt <- glue::glue("This is {. it} really", .open = "<", .close = ">") cli_text(txt) } @@ -60,7 +71,8 @@ test_that("S3 class is used for styling", { cli_div( theme = list( div = list("class-map" = list("foo" = "bar")), - ".bar" = list(before = "::")) + ".bar" = list(before = "::") + ) ) obj <- structure("yep", class = "foo") cli_text("This is {obj}.") diff --git a/tests/testthat/test-keypress.R b/tests/testthat/test-keypress.R index d55dd0da..875f0556 100644 --- a/tests/testthat/test-keypress.R +++ b/tests/testthat/test-keypress.R @@ -1,4 +1,3 @@ - test_that("control characaters", { skip_on_cran() p <- r_pty() @@ -27,17 +26,57 @@ test_that("write ahead", { test_that("arrows, etc", { skip_on_cran() p <- r_pty() - keys <- paste0("\033", c( - "[A", "[C", "[D", "[F", "[H", "-", - "OA", "OB", "OC", "OD", "OF", "OH", "-", - "[1~", "[2~", "[3~", "[4~", "[5~", "[6~", "-", - "[[5~", "[[6~", "-", - "[[7~", "[[8~", "-", - "OP", "OQ", "OR", "OS", "-", - "[15~", "[17~", "[18~", "[19~", "[20~", "[21~", "[23~", "[24~", "-", - "[11~", "[12~", "[13~", "[14~", "-", - "" - )) + keys <- paste0( + "\033", + c( + "[A", + "[C", + "[D", + "[F", + "[H", + "-", + "OA", + "OB", + "OC", + "OD", + "OF", + "OH", + "-", + "[1~", + "[2~", + "[3~", + "[4~", + "[5~", + "[6~", + "-", + "[[5~", + "[[6~", + "-", + "[[7~", + "[[8~", + "-", + "OP", + "OQ", + "OR", + "OS", + "-", + "[15~", + "[17~", + "[18~", + "[19~", + "[20~", + "[21~", + "[23~", + "[24~", + "-", + "[11~", + "[12~", + "[13~", + "[14~", + "-", + "" + ) + ) keys[keys == "\033-"] <- "-" expect_snapshot({ for (key in keys) { diff --git a/tests/testthat/test-links.R b/tests/testthat/test-links.R index aec64cac..60f16f8d 100644 --- a/tests/testthat/test-links.R +++ b/tests/testthat/test-links.R @@ -1,122 +1,155 @@ - # -- {.email} ------------------------------------------------------------- -test_that_cli(configs = c("plain", "fancy"), links = c("all", "none"), - "{.email}", { - - expect_snapshot({ - cli_text("{.email bugs.bunny@acme.com}") - }) -}) - -test_that_cli(configs = c("plain", "fancy"), links = c("all", "none"), - "{.email} vectors", { - - expect_snapshot({ - emails <- paste0("bugs.bunny-", 1:3, "@acme.com") - cli_text("{.email {emails}}") - }) -}) +test_that_cli( + configs = c("plain", "fancy"), + links = c("all", "none"), + "{.email}", + { + expect_snapshot({ + cli_text("{.email bugs.bunny@acme.com}") + }) + } +) + +test_that_cli( + configs = c("plain", "fancy"), + links = c("all", "none"), + "{.email} vectors", + { + expect_snapshot({ + emails <- paste0("bugs.bunny-", 1:3, "@acme.com") + cli_text("{.email {emails}}") + }) + } +) # -- {.file} and {.path} -------------------------------------------------- -test_that_cli(configs = c("plain", "fancy"), links = c("all", "none"), - "{.file} and {.path}", { - - withr::local_envvar(R_CLI_HYPERLINK_STYLE = NA_character_) - - # absolute path - expect_snapshot({ - cli_text("{.file /absolute/path}") - cli_text("{.file file:///absolute/path}") - cli_text("{.path /absolute/path}") - cli_text("{.path file:///absolute/path}") - }) - - # relative path - expect_snapshot({ - cli_text("{.file relative/path}") - cli_text("{.file ./relative/path}") - cli_text("{.path relative/path}") - cli_text("{.path ./relative/path}") - }, transform = sanitize_wd) +test_that_cli( + configs = c("plain", "fancy"), + links = c("all", "none"), + "{.file} and {.path}", + { + withr::local_envvar(R_CLI_HYPERLINK_STYLE = NA_character_) + + # absolute path + expect_snapshot({ + cli_text("{.file /absolute/path}") + cli_text("{.file file:///absolute/path}") + cli_text("{.path /absolute/path}") + cli_text("{.path file:///absolute/path}") + }) + + # relative path + expect_snapshot( + { + cli_text("{.file relative/path}") + cli_text("{.file ./relative/path}") + cli_text("{.path relative/path}") + cli_text("{.path ./relative/path}") + }, + transform = sanitize_wd + ) - # ~ - expect_snapshot({ - cli_text("{.file ~/relative/path}") - cli_text("{.path ~/relative/path}") - }, transform = sanitize_home) + # ~ + expect_snapshot( + { + cli_text("{.file ~/relative/path}") + cli_text("{.path ~/relative/path}") + }, + transform = sanitize_home + ) - # vectorized - expect_snapshot({ - paths <- c("~/foo", "bar", "file:///abs") - cli_text("{.file {paths}}") - }, transform = function(x) sanitize_home(sanitize_wd(x))) + # vectorized + expect_snapshot( + { + paths <- c("~/foo", "bar", "file:///abs") + cli_text("{.file {paths}}") + }, + transform = function(x) sanitize_home(sanitize_wd(x)) + ) - # weird names - expect_snapshot({ - paths <- c("foo ", " bar ", "file:///a bs ") - cli_text("{.file {paths}}") - }, transform = sanitize_wd) + # weird names + expect_snapshot( + { + paths <- c("foo ", " bar ", "file:///a bs ") + cli_text("{.file {paths}}") + }, + transform = sanitize_wd + ) - # hand created hyperlink is skipped - expect_snapshot({ - name <- cli::style_hyperlink("/foo/bar", "/foo/bar") - cli_text("{.file {name}}") - }) + # hand created hyperlink is skipped + expect_snapshot({ + name <- cli::style_hyperlink("/foo/bar", "/foo/bar") + cli_text("{.file {name}}") + }) + + # line numbers + expect_snapshot({ + cli_text("{.file /absolute/path:12}") + cli_text("{.file file:///absolute/path:5}") + cli_text("{.path /absolute/path:123}") + cli_text("{.path file:///absolute/path:51}") + }) + expect_snapshot( + { + cli_text("{.file relative/path:12}") + cli_text("{.file ./relative/path:5}") + cli_text("{.path relative/path:123}") + cli_text("{.path ./relative/path:51}") + }, + transform = sanitize_wd + ) + expect_snapshot( + { + cli_text("{.file ~/relative/path:12}") + cli_text("{.path ~/relative/path:5}") + }, + transform = sanitize_home + ) - # line numbers - expect_snapshot({ - cli_text("{.file /absolute/path:12}") - cli_text("{.file file:///absolute/path:5}") - cli_text("{.path /absolute/path:123}") - cli_text("{.path file:///absolute/path:51}") - }) - expect_snapshot({ - cli_text("{.file relative/path:12}") - cli_text("{.file ./relative/path:5}") - cli_text("{.path relative/path:123}") - cli_text("{.path ./relative/path:51}") - }, transform = sanitize_wd) - expect_snapshot({ - cli_text("{.file ~/relative/path:12}") - cli_text("{.path ~/relative/path:5}") - }, transform = sanitize_home) + # line and column numbers + expect_snapshot({ + cli_text("{.file /absolute/path:12:5}") + cli_text("{.file file:///absolute/path:5:100}") + cli_text("{.path /absolute/path:123:1}") + cli_text("{.path file:///absolute/path:51:6}") + }) + expect_snapshot( + { + cli_text("{.file relative/path:12:13}") + cli_text("{.file ./relative/path:5:20}") + cli_text("{.path relative/path:123:21}") + cli_text("{.path ./relative/path:51:2}") + }, + transform = sanitize_wd + ) + expect_snapshot( + { + cli_text("{.file ~/relative/path:12:23}") + cli_text("{.path ~/relative/path:5:2}") + }, + transform = sanitize_home + ) + expect_snapshot( + { + paths <- c("~/foo", "bar:10", "file:///abs:10:20") + cli_text("{.file {paths}}") + }, + transform = function(x) sanitize_home(sanitize_wd(x)) + ) - # line and column numbers - expect_snapshot({ - cli_text("{.file /absolute/path:12:5}") - cli_text("{.file file:///absolute/path:5:100}") - cli_text("{.path /absolute/path:123:1}") - cli_text("{.path file:///absolute/path:51:6}") - }) - expect_snapshot({ - cli_text("{.file relative/path:12:13}") - cli_text("{.file ./relative/path:5:20}") - cli_text("{.path relative/path:123:21}") - cli_text("{.path ./relative/path:51:2}") - }, transform = sanitize_wd) - expect_snapshot({ - cli_text("{.file ~/relative/path:12:23}") - cli_text("{.path ~/relative/path:5:2}") - }, transform = sanitize_home) - expect_snapshot({ - paths <- c("~/foo", "bar:10", "file:///abs:10:20") - cli_text("{.file {paths}}") - }, transform = function(x) sanitize_home(sanitize_wd(x))) - - local_mocked_bindings(is_windows = function() TRUE) - expect_equal( - abs_path1("c:/foo/bar"), - "file://c:/foo/bar" - ) -}) + local_mocked_bindings(is_windows = function() TRUE) + expect_equal( + abs_path1("c:/foo/bar"), + "file://c:/foo/bar" + ) + } +) # -- {.fun} --------------------------------------------------------------- -test_that_cli(configs = "plain", links = c("all", "none"), - "{.fun}", { - +test_that_cli(configs = "plain", links = c("all", "none"), "{.fun}", { expect_snapshot({ cli_text("{.fun myfun}") cli_text("{.fun mypackage::myfun}") @@ -144,9 +177,7 @@ test_that_cli(configs = "plain", links = "all", ".fun with custom format", { # -- {.help} -------------------------------------------------------------- -test_that_cli(configs = "plain", links = c("all", "none"), - "{.help}", { - +test_that_cli(configs = "plain", links = c("all", "none"), "{.help}", { expect_snapshot({ cli_text("{.help pkg::fun}") cli_text("{.help [link text](pkg::fun)}") @@ -167,8 +198,7 @@ test_that_cli(configs = "plain", links = "all", ".help with custom format", { # -- {.href} -------------------------------------------------------------- -test_that_cli(configs = "plain", links = c("all", "none"), - "{.href}", { +test_that_cli(configs = "plain", links = c("all", "none"), "{.href}", { expect_snapshot({ cli_text("{.href https://cli.r-lib.org}") cli_text("{.href [linktext](https://cli.r-lib.org)}") @@ -176,8 +206,7 @@ test_that_cli(configs = "plain", links = c("all", "none"), }) }) -test_that_cli(configs = "plain", links = c("all", "none"), - "{.href} vectors", { +test_that_cli(configs = "plain", links = c("all", "none"), "{.href} vectors", { expect_snapshot({ url <- paste0("https://cli.r-lib.org/", 1:3) cli_text("{.href {url}}") @@ -186,16 +215,14 @@ test_that_cli(configs = "plain", links = c("all", "none"), # -- {.run} --------------------------------------------------------------- -test_that_cli(configs = "plain", links = c("all", "none"), - "{.run}", { +test_that_cli(configs = "plain", links = c("all", "none"), "{.run}", { expect_snapshot({ cli_text("{.run pkg::fun(param)}") cli_text("{.run [run(p1, p2)](pkg::fun(p1, p2, other = 'foo'))}") }) }) -test_that_cli(configs = "plain", links = c("all", "none"), - "{.run} vectors", { +test_that_cli(configs = "plain", links = c("all", "none"), "{.run} vectors", { expect_snapshot({ codes <- paste0("pkg::fun", 1:3, "()") cli_text("{.run {codes}}") @@ -211,9 +238,7 @@ test_that_cli(configs = "plain", links = "all", ".run with custom format", { # -- {.topic} ------------------------------------------------------------- -test_that_cli(configs = "plain", links = c("all", "none"), - "{.topic}", { - +test_that_cli(configs = "plain", links = c("all", "none"), "{.topic}", { expect_snapshot({ cli_text("{.topic pkg::topic}") cli_text("{.topic [link text](pkg::topic)}") @@ -234,20 +259,28 @@ test_that_cli(configs = "plain", links = "all", ".topic with custom format", { # -- {.url} --------------------------------------------------------------- -test_that_cli(configs = c("plain", "fancy"), links = c("all", "none"), - "{.url}", { - expect_snapshot({ - cli_text("{.url https://cli.r-lib.org}") - }) -}) - -test_that_cli(configs = c("plain", "fancy"), links = c("all", "none"), - "{.url} vector", { - expect_snapshot({ - urls <- paste0("https://cli.r-lib.org/", 1:3) - cli_text("{.url {urls}}") - }) -}) +test_that_cli( + configs = c("plain", "fancy"), + links = c("all", "none"), + "{.url}", + { + expect_snapshot({ + cli_text("{.url https://cli.r-lib.org}") + }) + } +) + +test_that_cli( + configs = c("plain", "fancy"), + links = c("all", "none"), + "{.url} vector", + { + expect_snapshot({ + urls <- paste0("https://cli.r-lib.org/", 1:3) + cli_text("{.url {urls}}") + }) + } +) test_that_cli(configs = "plain", links = "all", "linked {.url}", { expect_snapshot({ @@ -267,9 +300,7 @@ test_that("make_link_url", { # -- {.vignette} ---------------------------------------------------------- -test_that_cli(configs = "plain", links = c("all", "none"), - "{.vignette}", { - +test_that_cli(configs = "plain", links = c("all", "none"), "{.vignette}", { expect_snapshot({ cli_text("{.vignette pkg::name}") cli_text("{.vignette [link text](pkg::name)}") @@ -281,9 +312,16 @@ test_that_cli(configs = "plain", links = c("all", "none"), }) }) -test_that_cli(configs = "plain", links = "all", ".vignette with custom format", { - withr::local_options(cli.hyperlink_vignette_url_format = "aaa-{vignette}-zzz") - expect_snapshot({ - cli_text("{.vignette pkgdown::accessibility}") - }) -}) +test_that_cli( + configs = "plain", + links = "all", + ".vignette with custom format", + { + withr::local_options( + cli.hyperlink_vignette_url_format = "aaa-{vignette}-zzz" + ) + expect_snapshot({ + cli_text("{.vignette pkgdown::accessibility}") + }) + } +) diff --git a/tests/testthat/test-lists.R b/tests/testthat/test-lists.R index 19c3fcfe..0079a91b 100644 --- a/tests/testthat/test-lists.R +++ b/tests/testthat/test-lists.R @@ -1,4 +1,3 @@ - start_app() on.exit(stop_app(), add = TRUE) diff --git a/tests/testthat/test-meta.R b/tests/testthat/test-meta.R index 55398628..26efbb26 100644 --- a/tests/testthat/test-meta.R +++ b/tests/testthat/test-meta.R @@ -1,4 +1,3 @@ - start_app() on.exit(stop_app(), add = TRUE) diff --git a/tests/testthat/test-non-breaking-space.R b/tests/testthat/test-non-breaking-space.R index f81589af..cf1dae73 100644 --- a/tests/testthat/test-non-breaking-space.R +++ b/tests/testthat/test-non-breaking-space.R @@ -1,4 +1,3 @@ - test_that("does not break", { testthat::local_reproducible_output(unicode = TRUE) expect_snapshot(local({ diff --git a/tests/testthat/test-num-ansi-colors.R b/tests/testthat/test-num-ansi-colors.R index 29a5b3f1..8dcc8545 100644 --- a/tests/testthat/test-num-ansi-colors.R +++ b/tests/testthat/test-num-ansi-colors.R @@ -1,6 +1,7 @@ test_that("win10_build works for different osVersion", { local_mocked_bindings( - sessionInfo = function() list(running = NULL), .package = "utils" + sessionInfo = function() list(running = NULL), + .package = "utils" ) expect_identical(win10_build(), 0L) @@ -18,7 +19,6 @@ test_that("win10_build works for different osVersion", { }) test_that("cli.default_num_colors #1", { - # crayon.enabled withr::local_envvar(R_CLI_NUM_COLORS = NA_character_) withr::local_options( @@ -35,7 +35,6 @@ test_that("cli.default_num_colors #1", { }) test_that("cli.default_num_colors #2", { - # Windows emacs withr::local_envvar( R_CLI_NUM_COLORS = NA_character_, @@ -61,7 +60,6 @@ test_that("cli.default_num_colors #2", { }) test_that("cli.default_num_colors #3", { - # non-truecolor COLORMAP withr::local_envvar(COLORTERM = "other") withr::local_options(cli.default_num_colors = NULL) @@ -73,7 +71,6 @@ test_that("cli.default_num_colors #3", { }) test_that("cli.default_num_colors #4", { - # Unix emacs with color withr::local_envvar(COLORTERM = NA_character_) @@ -91,7 +88,6 @@ test_that("cli.default_num_colors #4", { }) test_that("cli.default_num_colors #5", { - # rstudio terminal on Windows withr::local_envvar(COLORTERM = NA_character_) @@ -110,7 +106,6 @@ test_that("cli.default_num_colors #5", { }) test_that("cli.default_num_colors #6", { - # Windows 10 terminal withr::local_envvar(COLORTERM = NA_character_) withr::local_options(cli.default_num_colors = NULL) @@ -131,7 +126,6 @@ test_that("cli.default_num_colors #6", { }) test_that("cli.default_num_colors #7", { - # conemu or cmder withr::local_envvar( COLORTERM = NA_character_, @@ -149,7 +143,6 @@ test_that("cli.default_num_colors #7", { }) test_that("cli.default_num_colors #8", { - # unix terminal, xterm withr::local_envvar( COLORTERM = NA_character_, diff --git a/tests/testthat/test-package.R b/tests/testthat/test-package.R index 004b8381..f05c05a4 100644 --- a/tests/testthat/test-package.R +++ b/tests/testthat/test-package.R @@ -1,4 +1,3 @@ - test_that("No leftover SVG figures", { skip_on_cran() skip_on_covr() @@ -15,7 +14,10 @@ test_that("No leftover SVG figures", { sort(unique(rd_figs)) ) - figs2 <- dir(file.path(pkg_dir, "man", "figures", "README"), pattern = "[.]svg$") + figs2 <- dir( + file.path(pkg_dir, "man", "figures", "README"), + pattern = "[.]svg$" + ) readme <- file.path(pkg_dir, "README.md") readme_figs <- grep("man/figures/", readLines(readme), value = TRUE) readme_figs <- sub("^.*man/figures/README/(.*[.]svg).*$", "\\1", readme_figs) diff --git a/tests/testthat/test-pluralization.R b/tests/testthat/test-pluralization.R index 994e8585..38091fa2 100644 --- a/tests/testthat/test-pluralization.R +++ b/tests/testthat/test-pluralization.R @@ -1,4 +1,3 @@ - start_app() on.exit(stop_app(), add = TRUE) @@ -26,7 +25,8 @@ test_that("multiple substitutions", { test_that("multiple quantities", { expect_snapshot({ for (m in 0:2) for (n in 0:2) cli_text("{m} package{?s} and {n} folder{?s}") - for (m in 0:2) for (n in 0:2) print(pluralize("{m} package{?s} and {n} folder{?s}")) + for (m in 0:2) + for (n in 0:2) print(pluralize("{m} package{?s} and {n} folder{?s}")) }) }) diff --git a/tests/testthat/test-prettycode.R b/tests/testthat/test-prettycode.R index 5f5cbfb0..71aa2784 100644 --- a/tests/testthat/test-prettycode.R +++ b/tests/testthat/test-prettycode.R @@ -1,22 +1,35 @@ - -col_seq <- list(function(x) - paste0("1", x), - function(x) - paste0("2", x), - function(x) - paste0("3", x)) +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("[", "]", "(", ")", "{", "}"), col_seq), - c("1[", "1]", "1(", "1)", "1{", "1}")) - + expect_equal( + color_brackets(c("[", "]", "(", ")", "{", "}"), col_seq), + c("1[", "1]", "1(", "1)", "1{", "1}") + ) + # [({[({})]})] expect_equal( - color_brackets(c( - "[", "(", "{", "[", "(", "{", "}", ")", "]", "}", ")", "]" + color_brackets( + c( + "[", + "(", + "{", + "[", + "(", + "{", + "}", + ")", + "]", + "}", + ")", + "]" + ), + col_seq ), - col_seq), c( "1[", "2(", @@ -32,7 +45,7 @@ test_that("bracket highlighting", { "1]" ) ) - + # [[ [] ]][[ ()() ]] expect_equal( color_brackets( @@ -85,7 +98,6 @@ test_that_cli(configs = c("plain", "ansi"), "null", { }) test_that_cli(configs = c("plain", "ansi"), "operator", { - expect_snapshot({ cat(code_highlight("~ ! 1 - 2 + 3:4 * 5 / 6 ^ 7", list(operator = "bold"))) cat(code_highlight( @@ -154,12 +166,14 @@ test_that("replace_in_place corner cases", { test_that_cli(configs = c("plain", "ansi"), "parse errors", { expect_equal( - code_highlight("not good!!!"), "not good!!!" + code_highlight("not good!!!"), + "not good!!!" ) cnd <- NULL withCallingHandlers( expect_equal( - code_highlight("not good!!!"), "not good!!!" + code_highlight("not good!!!"), + "not good!!!" ), cli_parse_failure = function(e) cnd <<- e ) @@ -218,7 +232,10 @@ test_that("code_theme_list", { }) test_that_cli(configs = "ansi", "new language features, raw strings", { - if (getRversion() < "4.0.1") { expect_true(TRUE); return() } + if (getRversion() < "4.0.1") { + expect_true(TRUE) + return() + } expect_snapshot( cat(code_highlight( '"old" + r"("new""")"', @@ -228,14 +245,20 @@ test_that_cli(configs = "ansi", "new language features, raw strings", { }) test_that_cli(configs = "ansi", "new language features, pipe", { - if (getRversion() < "4.1.0") { expect_true(TRUE); return() } + if (getRversion() < "4.1.0") { + expect_true(TRUE) + return() + } expect_snapshot( cat(code_highlight('dir() |> toupper()', list(operator = "bold"))) ) }) test_that_cli(configs = "ansi", "new language features, lambda functions", { - if (getRversion() < "4.1.0") { expect_true(TRUE); return() } + if (getRversion() < "4.1.0") { + expect_true(TRUE) + return() + } expect_snapshot( cat(code_highlight('\\(x) x * 2', list(reserved = "bold"))) ) diff --git a/tests/testthat/test-progress-along.R b/tests/testthat/test-progress-along.R index 4390b136..1494f84c 100644 --- a/tests/testthat/test-progress-along.R +++ b/tests/testthat/test-progress-along.R @@ -1,4 +1,3 @@ - test_that("cli_progress_along crud", { fun <- function() { sapply(cli_progress_along(letters), function(i) i) @@ -63,7 +62,9 @@ test_that("cli_progress_along error", { suppressWarnings(testthat::local_reproducible_output()) lapply( cli::cli_progress_along(1:10, clear = FALSE), - function(i) { if (i == 5) stop("oops") } + function(i) { + if (i == 5) stop("oops") + } ) } diff --git a/tests/testthat/test-progress-bar.R b/tests/testthat/test-progress-bar.R index 3fd29965..e4b8075b 100644 --- a/tests/testthat/test-progress-bar.R +++ b/tests/testthat/test-progress-bar.R @@ -1,4 +1,3 @@ - test_that_cli("make_progress_bar", { withr::local_options( cli.progress_bar_style = NULL, diff --git a/tests/testthat/test-progress-c.R b/tests/testthat/test-progress-c.R index b5afee25..886c562e 100644 --- a/tests/testthat/test-progress-c.R +++ b/tests/testthat/test-progress-c.R @@ -1,4 +1,3 @@ - test_that("c api #1", { skip_on_cran() withr::local_options(cli.ansi = TRUE, cli.dynamic = TRUE) diff --git a/tests/testthat/test-progress-client.R b/tests/testthat/test-progress-client.R index 210d5b74..17e52a6e 100644 --- a/tests/testthat/test-progress-client.R +++ b/tests/testthat/test-progress-client.R @@ -1,4 +1,3 @@ - test_that("cli_progress_bar", { withr::local_options(cli.dynamic = FALSE, cli.ansi = FALSE) fun <- function() { @@ -20,9 +19,17 @@ test_that("custom format needs a format string", { test_that("removes previous progress bar", { withr::local_options(cli.dynamic = FALSE, cli.ansi = FALSE) fun <- function() { - bar <- cli_progress_bar(format = "first", format_done = "first done", clear = FALSE) + bar <- cli_progress_bar( + format = "first", + format_done = "first done", + clear = FALSE + ) cli_progress_update(force = TRUE) - bar2 <- cli_progress_bar(format = "second", format_done = "second done", clear = FALSE) + bar2 <- cli_progress_bar( + format = "second", + format_done = "second done", + clear = FALSE + ) cli_progress_update(force = TRUE) } @@ -133,11 +140,20 @@ test_that("format changes if we (un)learn total", { test_that("auto-terminate", { withr::local_options(cli.dynamic = FALSE, cli.ansi = FALSE) fun <- function() { - bar <- cli_progress_bar(total = 10, format = "first", format_done = "first done", clear = FALSE) + bar <- cli_progress_bar( + total = 10, + format = "first", + format_done = "first done", + clear = FALSE + ) cli_progress_update(force = TRUE) cli_progress_update(force = TRUE, set = 10) cli_text("First is done by now.\n") - bar2 <- cli_progress_bar(format = "second", format_done = "second done", clear = FALSE) + bar2 <- cli_progress_bar( + format = "second", + format_done = "second done", + clear = FALSE + ) cli_progress_update(force = TRUE) } @@ -178,5 +194,8 @@ test_that("cli_progress_bar handles Inf like NA", { cli_progress_update(force = TRUE) cli_progress_done(id = bar) } - expect_equal(capture_cli_messages(fun(total = NA)), capture_cli_messages(fun(total = Inf))) + expect_equal( + capture_cli_messages(fun(total = NA)), + capture_cli_messages(fun(total = Inf)) + ) }) diff --git a/tests/testthat/test-progress-handler-logger.R b/tests/testthat/test-progress-handler-logger.R index 997df718..74f378df 100644 --- a/tests/testthat/test-progress-handler-logger.R +++ b/tests/testthat/test-progress-handler-logger.R @@ -1,4 +1,3 @@ - test_that("loggerr_out", { bar <- new.env(parent = emptyenv()) bar$id <- "id" diff --git a/tests/testthat/test-progress-handler-say.R b/tests/testthat/test-progress-handler-say.R index c2b70895..2b0e395a 100644 --- a/tests/testthat/test-progress-handler-say.R +++ b/tests/testthat/test-progress-handler-say.R @@ -1,4 +1,3 @@ - test_that("say_out", { px <- asNamespace("processx")$get_tool("px") tmp <- tempfile("cli-test-") diff --git a/tests/testthat/test-progress-handlers.R b/tests/testthat/test-progress-handlers.R index db88eeab..1f094494 100644 --- a/tests/testthat/test-progress-handlers.R +++ b/tests/testthat/test-progress-handlers.R @@ -1,4 +1,3 @@ - test_that("cli_progress_builtin_handlers", { expect_true(is.character(cli_progress_builtin_handlers())) expect_true(all( diff --git a/tests/testthat/test-progress-message.R b/tests/testthat/test-progress-message.R index 5e177cd2..e4bfd1d4 100644 --- a/tests/testthat/test-progress-message.R +++ b/tests/testthat/test-progress-message.R @@ -1,4 +1,3 @@ - test_that("cli_progress_message", { withr::local_options(cli.dynamic = FALSE, cli.ansi = FALSE) fun <- function() { diff --git a/tests/testthat/test-progress-ticking.R b/tests/testthat/test-progress-ticking.R index 250ad9b9..fb3710c3 100644 --- a/tests/testthat/test-progress-ticking.R +++ b/tests/testthat/test-progress-ticking.R @@ -1,4 +1,3 @@ - test_that("ticking", { withr::local_options( cli.ansi = TRUE, @@ -9,11 +8,18 @@ test_that("ticking", { fun <- function() { i <- 0L - while (ticking(i < 10L, total = 10L, name = "ticking", format = "{cli::pb_current}/{cli::pb_total}")) { + while ( + ticking( + i < 10L, + total = 10L, + name = "ticking", + format = "{cli::pb_current}/{cli::pb_total}" + ) + ) { i <- i + 1L } } - + out <- capture_cli_messages(cli_with_ticks(fun())) expect_snapshot(out) }) diff --git a/tests/testthat/test-progress-types.R b/tests/testthat/test-progress-types.R index 2df65481..964e9728 100644 --- a/tests/testthat/test-progress-types.R +++ b/tests/testthat/test-progress-types.R @@ -1,4 +1,3 @@ - start_app() on.exit(stop_app(), add = TRUE) @@ -9,7 +8,7 @@ test_that("iterator", { cli.spinner = NULL, cli.spinner_unicode = NULL, cli.progress_format_iterator = NULL, - cli.progress_format_iterator_nototal= NULL, + cli.progress_format_iterator_nototal = NULL, cli.width = Inf ) @@ -36,7 +35,7 @@ test_that("tasks", { cli.spinner = NULL, cli.spinner_unicode = NULL, cli.progress_format_tasks = NULL, - cli.progress_format_tasks_nototal= NULL, + cli.progress_format_tasks_nototal = NULL, cli.width = Inf ) @@ -62,7 +61,7 @@ test_that("download", { cli.spinner = NULL, cli.spinner_unicode = NULL, cli.progress_format_download = NULL, - cli.progress_format_download_nototal= NULL + cli.progress_format_download_nototal = NULL ) fun <- function() { @@ -141,13 +140,21 @@ test_that("customize with options, download", { cli_progress_update(set = set, force = TRUE) } - expect_snapshot(capture_cli_messages(fun("download", 1024 * 1024, 512 * 1024))) + expect_snapshot(capture_cli_messages(fun( + "download", + 1024 * 1024, + 512 * 1024 + ))) expect_snapshot(capture_cli_messages(fun("download", NA, 512 * 1024))) withr::local_options( cli.progress_format_download_nototal = "new too {cli::pb_current_bytes}" ) - expect_snapshot(capture_cli_messages(fun("download", 1024 * 1024, 512 * 1024))) + expect_snapshot(capture_cli_messages(fun( + "download", + 1024 * 1024, + 512 * 1024 + ))) expect_snapshot(capture_cli_messages(fun("download", NA, 512 * 1024))) }) diff --git a/tests/testthat/test-progress-utils.R b/tests/testthat/test-progress-utils.R index b49416b8..e29aa8af 100644 --- a/tests/testthat/test-progress-utils.R +++ b/tests/testthat/test-progress-utils.R @@ -1,4 +1,3 @@ - test_that("cli_progress_num", { withr::local_options(cli.progress_handlers_only = "cli") fun <- function() { diff --git a/tests/testthat/test-progress-variables.R b/tests/testthat/test-progress-variables.R index 61bb0b6b..def768bf 100644 --- a/tests/testthat/test-progress-variables.R +++ b/tests/testthat/test-progress-variables.R @@ -1,4 +1,3 @@ - test_that("cli_progress_demo", { withr::local_options(cli.ansi = TRUE) out <- cli_progress_demo(live = FALSE, at = 50) @@ -91,7 +90,9 @@ test_that("pb_eta", { expect_equal(cli__pb_eta(NULL), "") local_mocked_bindings(cli__pb_eta_raw = function(...) NA_real_) expect_snapshot(cli__pb_eta(list())) - local_mocked_bindings(cli__pb_eta_raw = function(...) as.difftime(12, units = "secs")) + local_mocked_bindings( + cli__pb_eta_raw = function(...) as.difftime(12, units = "secs") + ) expect_snapshot(cli__pb_eta(list())) }) @@ -175,7 +176,7 @@ test_that("pb_rate_raw", { this <- 1 expect_equal(cli__pb_rate_raw(list(current = 23)), 23) this <- 10 - expect_equal(cli__pb_rate_raw(list(current = 1)), 1/10) + expect_equal(cli__pb_rate_raw(list(current = 1)), 1 / 10) }) test_that("pb_rate_bytes", { @@ -219,10 +220,13 @@ test_that("pb_timestamp", { expect_snapshot(cli__pb_timestamp(list())) backup <- mget(c("load_time", "speed_time"), clienv) - on.exit({ - clienv$load_time <- backup$load_time - clienv$speed_time <- backup$speed_time - }, add = TRUE) + on.exit( + { + clienv$load_time <- backup$load_time + clienv$speed_time <- backup$speed_time + }, + add = TRUE + ) clienv$load_time <- fake - 10 clienv$speed_time <- 3.0 diff --git a/tests/testthat/test-rlang-errors.R b/tests/testthat/test-rlang-errors.R index db37c54f..7f0e9f9e 100644 --- a/tests/testthat/test-rlang-errors.R +++ b/tests/testthat/test-rlang-errors.R @@ -1,22 +1,28 @@ test_that_cli("cli_abort", { withr::local_options(cli.theme_dark = FALSE) - expect_snapshot(error = TRUE, local({ - n <- "boo" - cli_abort(c( - "{.var n} must be a numeric vector", - "x" = "You've supplied a {.cls {class(n)}} vector." - )) - })) + expect_snapshot( + error = TRUE, + local({ + n <- "boo" + cli_abort(c( + "{.var n} must be a numeric vector", + "x" = "You've supplied a {.cls {class(n)}} vector." + )) + }) + ) - expect_snapshot(error = TRUE, local({ - len <- 26 - idx <- 100 - cli_abort(c( - "Must index an existing element:", - "i" = "There {?is/are} {len} element{?s}.", - "x" = "You've tried to subset element {idx}." - )) - })) + expect_snapshot( + error = TRUE, + local({ + len <- 26 + idx <- 100 + cli_abort(c( + "Must index an existing element:", + "i" = "There {?is/are} {len} element{?s}.", + "x" = "You've tried to subset element {idx}." + )) + }) + ) n <- "boo" err <- tryCatch( @@ -36,7 +42,7 @@ test_that_cli("cli_warn", { expect_snapshot({ n <- "boo" cli_warn(c( - "{.var n} must be a numeric vector", + "{.var n} must be a numeric vector", "x" = "You've supplied a {.cls {class(n)}} vector." )) }) @@ -45,7 +51,7 @@ test_that_cli("cli_warn", { len <- 26 idx <- 100 cli_warn(c( - "Must index an existing element:", + "Must index an existing element:", "i" = "There {?is/are} {len} element{?s}.", "x" = "You've tried to subset element {idx}." )) @@ -59,7 +65,7 @@ test_that_cli("cli_inform", { expect_snapshot({ n <- "boo" cli_inform(c( - "{.var n} must be a numeric vector", + "{.var n} must be a numeric vector", "x" = "You've supplied a {.cls {class(n)}} vector." )) }) @@ -68,7 +74,7 @@ test_that_cli("cli_inform", { len <- 26 idx <- 100 cli_inform(c( - "Must index an existing element:", + "Must index an existing element:", "i" = "There {?is/are} {len} element{?s}.", "x" = "You've tried to subset element {idx}." )) @@ -78,23 +84,29 @@ test_that_cli("cli_inform", { test_that("cli_abort width in RStudio", { # this is to fix breakage with new testthat withr::local_options(cli.condition_width = getOption("cli.width")) - local_mocked_bindings(rstudio_detect = function() list(type = "rstudio_console")) + local_mocked_bindings( + rstudio_detect = function() list(type = "rstudio_console") + ) withr::local_rng_version("3.5.0") set.seed(42) - expect_snapshot(error = TRUE, local({ - len <- 26 - idx <- 100 - cli_abort(c( - lorem_ipsum(1, 3), - "i" = lorem_ipsum(1, 3), - "x" = lorem_ipsum(1, 3) - )) - })) + expect_snapshot( + error = TRUE, + local({ + len <- 26 + idx <- 100 + cli_abort(c( + lorem_ipsum(1, 3), + "i" = lorem_ipsum(1, 3), + "x" = lorem_ipsum(1, 3) + )) + }) + ) }) test_that_cli(configs = "ansi", "color in RStudio", { local_mocked_bindings( - rstudio_detect = function() list(type = "rstudio_console", num_colors = 256), + rstudio_detect = function() + list(type = "rstudio_console", num_colors = 256), get_rstudio_theme = function() list(foreground = "rgb(0, 0, 0)") ) expect_snapshot({ @@ -129,9 +141,12 @@ test_that("cli_abort() captures correct call and backtrace", { g <- function() h() h <- function() cli::cli_abort("foo") - expect_snapshot({ - print(expect_error(f())) - }, variant = paste0("rlang-", packageVersion("rlang"))) + expect_snapshot( + { + print(expect_error(f())) + }, + variant = paste0("rlang-", packageVersion("rlang")) + ) classed_stop <- function(message, env = parent.frame()) { cli::cli_abort( @@ -149,9 +164,12 @@ test_that("cli_abort() captures correct call and backtrace", { f <- function(x) g(x) g <- function(x) h(x) - expect_snapshot({ - print(expect_error(f(list()))) - }, variant = paste0("rlang-", packageVersion("rlang"))) + expect_snapshot( + { + print(expect_error(f(list()))) + }, + variant = paste0("rlang-", packageVersion("rlang")) + ) }) test_that("cli_abort(.internal = TRUE) reports the correct function (r-lib/rlang#1386)", { @@ -162,7 +180,10 @@ test_that("cli_abort(.internal = TRUE) reports the correct function (r-lib/rlang environment(fn) <- rlang::ns_env("base") # Should mention an internal error in the `base` package - expect_snapshot({ - (expect_error(fn())) - }, variant = paste0("rlang-", packageVersion("rlang"))) + expect_snapshot( + { + (expect_error(fn())) + }, + variant = paste0("rlang-", packageVersion("rlang")) + ) }) diff --git a/tests/testthat/test-rules.R b/tests/testthat/test-rules.R index 4e50e270..c85b5432 100644 --- a/tests/testthat/test-rules.R +++ b/tests/testthat/test-rules.R @@ -1,6 +1,4 @@ - test_that_cli("make_line", { - expect_equal(make_line(1, "-"), "-") expect_equal(make_line(0, "-"), "") expect_equal(make_line(2, "-"), "--") @@ -21,7 +19,6 @@ test_that("width option", { }) test_that("left label", { - expect_equal( rule("label", width = 12, line = "-"), rule_class("-- label ---") @@ -45,7 +42,6 @@ test_that("left label", { }) test_that("centered label", { - expect_error( rule(left = "label", center = "label"), "cannot be specified" @@ -109,9 +105,9 @@ test_that("right label", { }) test_that("line_col", { - withr::with_options( - list(cli.num_colors = 256L), { + list(cli.num_colors = 256L), + { expect_true(ansi_has_any( rule(line_col = "red") )) diff --git a/tests/testthat/test-sitrep.R b/tests/testthat/test-sitrep.R index 01b9b807..f338fa04 100644 --- a/tests/testthat/test-sitrep.R +++ b/tests/testthat/test-sitrep.R @@ -1,4 +1,3 @@ - test_that("sitrep runs", { expect_true(is.list(cli_sitrep())) expect_true(is.character(format(cli_sitrep()))) diff --git a/tests/testthat/test-spark.R b/tests/testthat/test-spark.R index c91c9285..ad96aa30 100644 --- a/tests/testthat/test-spark.R +++ b/tests/testthat/test-spark.R @@ -1,4 +1,3 @@ - test_that_cli(configs = c("plain", "unicode"), "spark_bar", { expect_snapshot({ spark_bar(seq(0, 1, length.out = 8)) diff --git a/tests/testthat/test-spinners.R b/tests/testthat/test-spinners.R index 0e0ea0ed..78a14ea5 100644 --- a/tests/testthat/test-spinners.R +++ b/tests/testthat/test-spinners.R @@ -1,4 +1,3 @@ - test_that("get_spinner", { if (is_utf8_output()) { expect_equal(get_spinner()$name, "dots") diff --git a/tests/testthat/test-status-bar.R b/tests/testthat/test-status-bar.R index 3a8b8678..c38a429f 100644 --- a/tests/testthat/test-status-bar.R +++ b/tests/testthat/test-status-bar.R @@ -23,12 +23,16 @@ test_that("output while status bar is active", { cli_status_update("status2", id = sb) } out <- ansi_strip(capt0(f())) - expect_equal(out, paste0( - "out1\n", - "\rstatus1\r", - "\r \rout2\nstatus1\r", - "\rstatus2\r", - "\r \r")) + expect_equal( + out, + paste0( + "out1\n", + "\rstatus1\r", + "\r \rout2\nstatus1\r", + "\rstatus2\r", + "\r \r" + ) + ) }) test_that("interpolation", { @@ -39,9 +43,13 @@ test_that("interpolation", { cli_status_clear() } out <- ansi_strip(capt0(f())) - expect_equal(out, paste0( - "\rYou see 1+1=2, this is {cli}\r", - "\r \r")) + expect_equal( + out, + paste0( + "\rYou see 1+1=2, this is {cli}\r", + "\r \r" + ) + ) }) test_that("update", { @@ -52,11 +60,15 @@ test_that("update", { cli_status_update("status2", id = sb) } out <- ansi_strip(capt0(f())) - expect_equal(out, paste0( - "out1\n", - "\rstatus1\r", - "\rstatus2\r", - "\r \r")) + expect_equal( + out, + paste0( + "out1\n", + "\rstatus1\r", + "\rstatus2\r", + "\r \r" + ) + ) }) test_that("keep", { @@ -80,14 +92,18 @@ test_that("multiple status bars", { cli_text("text3") } out <- ansi_strip(capt0(f())) - expect_equal(out, paste0( - "\rstatus1\r", - "\r \rtext1\nstatus1\r", # emit text1, restore status1 - "\rstatus2\r", # show status2 - "\r \rtext2\nstatus2\r", # emit text2, restore status2 - "\r \rstatus1\r", # clear status2, restore status1 - "\r \rtext3\nstatus1\r", # emit text3, restore status1 - "\r \r")) # (auto)clear status1 + expect_equal( + out, + paste0( + "\rstatus1\r", + "\r \rtext1\nstatus1\r", # emit text1, restore status1 + "\rstatus2\r", # show status2 + "\r \rtext2\nstatus2\r", # emit text2, restore status2 + "\r \rstatus1\r", # clear status2, restore status1 + "\r \rtext3\nstatus1\r", # emit text3, restore status1 + "\r \r" + ) + ) # (auto)clear status1 }) test_that("truncating", { @@ -102,9 +118,13 @@ test_that("truncating", { cli_status(c(txt, txt)) } out <- ansi_strip(capt0(f())) - expect_equal(out, paste0( - "\rEiusmod enim mollit aute aliquip Lore...\r", - "\r \r")) + expect_equal( + out, + paste0( + "\rEiusmod enim mollit aute aliquip Lore...\r", + "\r \r" + ) + ) }) test_that("ansi colors and clearing", { @@ -144,12 +164,15 @@ test_that("successful termination", { cli_status_clear(result = "done") } out <- ansi_strip(capt0(f())) - expect_equal(out, paste0( - "out1\n", - "\rstatus1\r", - "\r \rout2\nstatus1\r", - "\rstatus1 ... done\r\n" - )) + expect_equal( + out, + paste0( + "out1\n", + "\rstatus1\r", + "\r \rout2\nstatus1\r", + "\rstatus1 ... done\r\n" + ) + ) }) test_that("terminate with failed", { @@ -161,12 +184,15 @@ test_that("terminate with failed", { cli_status_clear(result = "failed") } out <- ansi_strip(capt0(f())) - expect_equal(out, paste0( - "out1\n", - "\rstatus1\r", - "\r \rout2\nstatus1\r", - "\rstatus1 ... failed\r\n" - )) + expect_equal( + out, + paste0( + "out1\n", + "\rstatus1\r", + "\r \rout2\nstatus1\r", + "\rstatus1 ... failed\r\n" + ) + ) }) test_that("auto close with success", { @@ -177,12 +203,15 @@ test_that("auto close with success", { cli_text("out2") } out <- ansi_strip(capt0(f())) - expect_equal(out, paste0( - "out1\n", - "\rstatus1\r", - "\r \rout2\nstatus1\r", - "\rstatus1 ... done\r\n" - )) + expect_equal( + out, + paste0( + "out1\n", + "\rstatus1\r", + "\r \rout2\nstatus1\r", + "\rstatus1 ... done\r\n" + ) + ) }) test_that("auto close wtih failure", { @@ -195,12 +224,15 @@ test_that("auto close wtih failure", { if (is_interactive()) Sys.sleep(2) } out <- ansi_strip(capt0(f())) - expect_equal(out, paste0( - "out1\n", - "\rstatus1\r", - "\r \rout2\nstatus1\r", - "\rstatus1 ... failed\r\n" - )) + expect_equal( + out, + paste0( + "out1\n", + "\rstatus1\r", + "\r \rout2\nstatus1\r", + "\rstatus1 ... failed\r\n" + ) + ) }) test_that("auto close with styling", { @@ -284,13 +316,15 @@ test_that("Emojis are cleaned up properly", { "\r\U0001F477\r", "\r \rout2\n\U0001F477\r", "\r\u2728\r", - "\r \r"), + "\r \r" + ), paste0( "out1\n", "\r\r", "\r \rout2\n\r", "\r\r", - "\r \r") + "\r \r" + ) ) expect_true(out %in% exps) }) @@ -323,12 +357,16 @@ test_that("auto-close with done or failure", { } out2 <- ansi_strip(capt0(tryCatch(f2(), error = function(err) NULL))) - expect_match(out2, fixed = TRUE, paste0( - "out1\n", - "\ri status1\r", - "\r \r", - "out2\n", - "i status1\r", - "\rx status1 ... failed\r\n" - )) + expect_match( + out2, + fixed = TRUE, + paste0( + "out1\n", + "\ri status1\r", + "\r \r", + "out2\n", + "i status1\r", + "\rx status1 ... failed\r\n" + ) + ) }) diff --git a/tests/testthat/test-subprocess.R b/tests/testthat/test-subprocess.R index cc9a06ef..90b37268 100644 --- a/tests/testthat/test-subprocess.R +++ b/tests/testthat/test-subprocess.R @@ -1,4 +1,3 @@ - test_that("events are properly generated", { skip_on_cran() ## This needs callr >= 3.0.0.90001, which is not yet on CRAN @@ -27,7 +26,8 @@ test_that("events are properly generated", { withCallingHandlers( rs$run(do), - cli_message = handler) + cli_message = handler + ) expect_equal(length(msgs), 4) lapply(msgs, expect_s3_class, "cli_message") @@ -55,13 +55,15 @@ test_that("subprocess with default handler", { on.exit(rs$kill(), add = TRUE) msgs <- list() - withr::with_options(list( - cli.default_handler = function(msg) { - msgs <<- c(msgs, list(msg)) - if (!is.null(findRestart("cli_message_handled"))) { - invokeRestart("cli_message_handled") + withr::with_options( + list( + cli.default_handler = function(msg) { + msgs <<- c(msgs, list(msg)) + if (!is.null(findRestart("cli_message_handled"))) { + invokeRestart("cli_message_handled") + } } - }), + ), rs$run(do) ) @@ -88,20 +90,24 @@ test_that("output in child process", { do <- function() { options(cli.num_colors = 256) - withCallingHandlers({ + withCallingHandlers( + { cli::start_app(theme = cli::simple_theme()) cli::cli_h1("Title") cli::cli_text("This is generated in the {.emph subprocess}.") "foobar" }, cli_message = function(msg) { - withCallingHandlers({ - cli:::cli_server_default(msg) - invokeRestart("cli_message_handled") }, + withCallingHandlers( + { + cli:::cli_server_default(msg) + invokeRestart("cli_message_handled") + }, message = function(mmsg) { class(mmsg) <- c("callr_message", "message", "condition") signalCondition(mmsg) - }) + } + ) } ) } diff --git a/tests/testthat/test-substitution.R b/tests/testthat/test-substitution.R index d080660b..b3ec8886 100644 --- a/tests/testthat/test-substitution.R +++ b/tests/testthat/test-substitution.R @@ -1,4 +1,3 @@ - start_app() on.exit(stop_app(), add = TRUE) diff --git a/tests/testthat/test-suppress.R b/tests/testthat/test-suppress.R index 6ef005d6..40e1cc29 100644 --- a/tests/testthat/test-suppress.R +++ b/tests/testthat/test-suppress.R @@ -1,4 +1,3 @@ - test_that("suppress output", { if (getRversion() >= "4.0.0") { cnd <- NULL diff --git a/tests/testthat/test-text.R b/tests/testthat/test-text.R index 630f735d..b237aad7 100644 --- a/tests/testthat/test-text.R +++ b/tests/testthat/test-text.R @@ -1,4 +1,3 @@ - start_app() on.exit(stop_app(), add = TRUE) diff --git a/tests/testthat/test-themes.R b/tests/testthat/test-themes.R index 50b7e835..999f0fa2 100644 --- a/tests/testthat/test-themes.R +++ b/tests/testthat/test-themes.R @@ -1,4 +1,3 @@ - start_app(.auto_close = TRUE) test_that_cli("add/remove/list themes", { @@ -21,18 +20,23 @@ test_that_cli("add/remove/list themes", { }) test_that("default theme is valid", { - expect_error({ - id <- default_app()$add_theme(builtin_theme()) - default_app()$remove_theme(id) - }, NA) + expect_error( + { + id <- default_app()$add_theme(builtin_theme()) + default_app()$remove_theme(id) + }, + NA + ) }) test_that("explicit formatter is used, and combined", { id <- default_app()$add_theme(list( "span.emph" = list( fmt = function(x) paste0("(((", x, ")))"), - before = "<<", after = ">>") - )) + before = "<<", + after = ">>" + ) + )) on.exit(default_app()$remove_theme(id), add = TRUE) expect_snapshot( cli_text("this is {.emph it}, really") diff --git a/tests/testthat/test-timer.R b/tests/testthat/test-timer.R index b6ed77f9..02b965c7 100644 --- a/tests/testthat/test-timer.R +++ b/tests/testthat/test-timer.R @@ -1,4 +1,3 @@ - test_that("ALTREP methods", { expect_equal(length(`__cli_update_due`), 1L) diff --git a/tests/testthat/test-tree.R b/tests/testthat/test-tree.R index 64aeac19..d2c70fa4 100644 --- a/tests/testthat/test-tree.R +++ b/tests/testthat/test-tree.R @@ -1,21 +1,59 @@ - test_that_cli("tree", { data <- data.frame( stringsAsFactors = FALSE, - package = c("processx", "backports", "assertthat", "Matrix", - "magrittr", "rprojroot", "clisymbols", "prettyunits", "withr", - "desc", "igraph", "R6", "crayon", "debugme", "digest", "irlba", - "rcmdcheck", "callr", "pkgconfig", "lattice"), + package = c( + "processx", + "backports", + "assertthat", + "Matrix", + "magrittr", + "rprojroot", + "clisymbols", + "prettyunits", + "withr", + "desc", + "igraph", + "R6", + "crayon", + "debugme", + "digest", + "irlba", + "rcmdcheck", + "callr", + "pkgconfig", + "lattice" + ), dependencies = I(list( - c("assertthat", "crayon", "debugme", "R6"), character(0), - character(0), "lattice", character(0), "backports", character(0), - c("magrittr", "assertthat"), character(0), + c("assertthat", "crayon", "debugme", "R6"), + character(0), + character(0), + "lattice", + character(0), + "backports", + character(0), + c("magrittr", "assertthat"), + character(0), c("assertthat", "R6", "crayon", "rprojroot"), - c("irlba", "magrittr", "Matrix", "pkgconfig"), character(0), - character(0), "crayon", character(0), "Matrix", - c("callr", "clisymbols", "crayon", "desc", "digest", "prettyunits", - "R6", "rprojroot", "withr"), - c("processx", "R6"), character(0), character(0) + c("irlba", "magrittr", "Matrix", "pkgconfig"), + character(0), + character(0), + "crayon", + character(0), + "Matrix", + c( + "callr", + "clisymbols", + "crayon", + "desc", + "digest", + "prettyunits", + "R6", + "rprojroot", + "withr" + ), + c("processx", "R6"), + character(0), + character(0) )) ) @@ -26,7 +64,7 @@ test_that_cli("tree", { # Check that trees with apparent circularity error nicely data <- data.frame( stringsAsFactors = FALSE, - X = c("a", "b", "c","d", "e", "f", "g", "h", "j"), + X = c("a", "b", "c", "d", "e", "f", "g", "h", "j"), Y = I(list( c("b", "e", "f"), c("d", "g"), @@ -44,11 +82,17 @@ test_that_cli("tree", { }) test_that_cli("trimming", { - pkgdeps <- list( - "dplyr@0.8.3" = c("assertthat@0.2.1", "glue@1.3.1", "magrittr@1.5", - "R6@2.4.0", "Rcpp@1.0.2", "rlang@0.4.0", "tibble@2.1.3", - "tidyselect@0.2.5"), + "dplyr@0.8.3" = c( + "assertthat@0.2.1", + "glue@1.3.1", + "magrittr@1.5", + "R6@2.4.0", + "Rcpp@1.0.2", + "rlang@0.4.0", + "tibble@2.1.3", + "tidyselect@0.2.5" + ), "assertthat@0.2.1" = character(), "glue@1.3.1" = character(), "magrittr@1.5" = character(), @@ -56,23 +100,45 @@ test_that_cli("trimming", { "R6@2.4.0" = character(), "Rcpp@1.0.2" = character(), "rlang@0.4.0" = character(), - "tibble@2.1.3" = c("cli@1.1.0", "crayon@1.3.4", "fansi@0.4.0", - "pillar@1.4.2", "pkgconfig@2.0.3", "rlang@0.4.0"), + "tibble@2.1.3" = c( + "cli@1.1.0", + "crayon@1.3.4", + "fansi@0.4.0", + "pillar@1.4.2", + "pkgconfig@2.0.3", + "rlang@0.4.0" + ), "cli@1.1.0" = c("assertthat@0.2.1", "crayon@1.3.4"), "crayon@1.3.4" = character(), "fansi@0.4.0" = character(), - "pillar@1.4.2" = c("cli@1.1.0", "crayon@1.3.4", "fansi@0.4.0", - "rlang@0.4.0", "utf8@1.1.4", "vctrs@0.2.0"), + "pillar@1.4.2" = c( + "cli@1.1.0", + "crayon@1.3.4", + "fansi@0.4.0", + "rlang@0.4.0", + "utf8@1.1.4", + "vctrs@0.2.0" + ), "utf8@1.1.4" = character(), - "vctrs@0.2.0" = c("backports@1.1.5", "ellipsis@0.3.0", - "digest@0.6.21", "glue@1.3.1", "rlang@0.4.0", "zeallot@0.1.0"), + "vctrs@0.2.0" = c( + "backports@1.1.5", + "ellipsis@0.3.0", + "digest@0.6.21", + "glue@1.3.1", + "rlang@0.4.0", + "zeallot@0.1.0" + ), "backports@1.1.5" = character(), "ellipsis@0.3.0" = c("rlang@0.4.0"), "digest@0.6.21" = character(), "glue@1.3.1" = character(), "zeallot@0.1.0" = character(), - "tidyselect@0.2.5" = c("glue@1.3.1", "purrr@1.3.1", "rlang@0.4.0", - "Rcpp@1.0.2"), + "tidyselect@0.2.5" = c( + "glue@1.3.1", + "purrr@1.3.1", + "rlang@0.4.0", + "Rcpp@1.0.2" + ), "purrr@0.3.3" = c("magrittr@1.5", "rlang@0.4.0") ) diff --git a/tests/testthat/test-type.R b/tests/testthat/test-type.R index 29921465..f9a2963e 100644 --- a/tests/testthat/test-type.R +++ b/tests/testthat/test-type.R @@ -1,4 +1,3 @@ - test_that("type style", { expect_snapshot({ # objects diff --git a/tests/testthat/test-utf8.R b/tests/testthat/test-utf8.R index f50940ec..30ab09d7 100644 --- a/tests/testthat/test-utf8.R +++ b/tests/testthat/test-utf8.R @@ -1,4 +1,3 @@ - # We need an UTF-8 platform or a recent R version on Windows utf8 <- l10n_info()$`UTF-8` diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index 10368873..7f921b38 100644 --- a/tests/testthat/test-utils.R +++ b/tests/testthat/test-utils.R @@ -1,4 +1,3 @@ - test_that("is_windows", { expect_equal(is_windows(), .Platform$OS.type == "windows") }) @@ -57,7 +56,6 @@ test_that("lpad", { }) test_that("is_utf8_output", { - local_mocked_bindings( l10n_info = function() list(MBCS = TRUE, `UTF-8` = TRUE, `Latin-1` = FALSE) ) @@ -76,7 +74,6 @@ test_that("is_utf8_output", { }) test_that("is_latex_output", { - local_mocked_bindings(loadedNamespaces = function() "foobar") expect_false(is_latex_output()) @@ -170,15 +167,16 @@ test_that("na.omit", { na.omit(character()) na.omit(integer()) na.omit(1:5) - na.omit(c(1,NA,2,NA)) + na.omit(c(1, NA, 2, NA)) na.omit(c(NA_integer_, NA_integer_)) - na.omit(list(1,2,3)) + na.omit(list(1, 2, 3)) }) }) test_that("get_rstudio_theme", { local_mocked_bindings( - getThemeInfo = function() function(...) warning("just a word"), .package = "rstudioapi" + getThemeInfo = function() function(...) warning("just a word"), + .package = "rstudioapi" ) expect_silent(get_rstudio_theme()) }) diff --git a/tests/testthat/test-verbatim.R b/tests/testthat/test-verbatim.R index ea4fc3b2..083fb369 100644 --- a/tests/testthat/test-verbatim.R +++ b/tests/testthat/test-verbatim.R @@ -1,4 +1,3 @@ - start_app() on.exit(stop_app(), add = TRUE) diff --git a/tests/testthat/test-vt.R b/tests/testthat/test-vt.R index 4d51d00f..938cbebc 100644 --- a/tests/testthat/test-vt.R +++ b/tests/testthat/test-vt.R @@ -1,4 +1,3 @@ - test_that("empty input", { expect_snapshot( vt_output("", width = 20, height = 2)$segment @@ -37,7 +36,11 @@ test_that("scroll up", { test_that_cli(configs = "ansi", "ANSI SGR", { expect_snapshot( - vt_output("12\033[31m34\033[1m56\033[39m78\033[21m90", width = 20, height = 2) + vt_output( + "12\033[31m34\033[1m56\033[39m78\033[21m90", + width = 20, + height = 2 + ) ) expect_snapshot( @@ -84,11 +87,31 @@ test_that("erase in line", { test_that("erase in screen", { expect_snapshot({ - vt_output("foo\nfoobar\nfoobar2\033[A\033[4D\033[J", width = 10, height = 4)$segment - vt_output("foo\nfoobar\nfoobar2\033[A\033[4D\033[0J", width = 10, height = 4)$segment - vt_output("foo\nfoobar\nfoobar2\033[A\033[4D\033[1J", width = 10, height = 4)$segment - vt_output("foo\nfoobar\nfoobar2\033[A\033[4D\033[2Jx", width = 10, height = 4)$segment - vt_output("foo\nfoobar\nfoobar2\033[A\033[4D\033[3Jx", width = 10, height = 4)$segment + vt_output( + "foo\nfoobar\nfoobar2\033[A\033[4D\033[J", + width = 10, + height = 4 + )$segment + vt_output( + "foo\nfoobar\nfoobar2\033[A\033[4D\033[0J", + width = 10, + height = 4 + )$segment + vt_output( + "foo\nfoobar\nfoobar2\033[A\033[4D\033[1J", + width = 10, + height = 4 + )$segment + vt_output( + "foo\nfoobar\nfoobar2\033[A\033[4D\033[2Jx", + width = 10, + height = 4 + )$segment + vt_output( + "foo\nfoobar\nfoobar2\033[A\033[4D\033[3Jx", + width = 10, + height = 4 + )$segment }) }) @@ -104,8 +127,14 @@ test_that("colors", { expect_equal(vt_output("\033[107mcolored\033[39m")$background_color[1], "15") expect_equal(vt_output("\033[38;5;100mcolored\033[39m")$color[1], "100") - expect_equal(vt_output("\033[48;5;110mcolored\033[39m")$background_color[1], "110") + expect_equal( + vt_output("\033[48;5;110mcolored\033[39m")$background_color[1], + "110" + ) expect_equal(vt_output("\033[38;2;1;2;3mcolored\033[39m")$color[1], "#010203") - expect_equal(vt_output("\033[48;2;4;5;6mcolored\033[39m")$background_color[1], "#040506") + expect_equal( + vt_output("\033[48;2;4;5;6mcolored\033[39m")$background_color[1], + "#040506" + ) }) diff --git a/tools/get-rstudio-themes.R b/tools/get-rstudio-themes.R index d87541d8..63b17a30 100644 --- a/tools/get-rstudio-themes.R +++ b/tools/get-rstudio-themes.R @@ -1,4 +1,3 @@ - library(css) rstudio_theme_details_map <- list( @@ -45,29 +44,29 @@ rstudio_theme_url_template <- paste0( ## We need to explicity set themes that should be overridden with the default ## vaue to NULL operator_theme_map <- list( - "solarized_light" = "#93A1A1", - "solarized_dark" = "#B58900", - "twilight" = "#7587A6", - "idle_fingers" = "#6892B2", - "clouds_midnight" = "#A53553", - "cobalt" = "#BED6FF", - "kr_theme" = "#A56464", - "clouds" = NULL, - "dawn" = NULL, - "eclipse" = NULL, - "katzenmilch" = NULL, - "merbivore" = NULL, - "merbivore_soft" = NULL, - "monokai" = NULL, - "pastel_on_dark" = NULL, - "vibrant_ink" = NULL, - "xcode" = NULL + "solarized_light" = "#93A1A1", + "solarized_dark" = "#B58900", + "twilight" = "#7587A6", + "idle_fingers" = "#6892B2", + "clouds_midnight" = "#A53553", + "cobalt" = "#BED6FF", + "kr_theme" = "#A56464", + "clouds" = NULL, + "dawn" = NULL, + "eclipse" = NULL, + "katzenmilch" = NULL, + "merbivore" = NULL, + "merbivore_soft" = NULL, + "monokai" = NULL, + "pastel_on_dark" = NULL, + "vibrant_ink" = NULL, + "xcode" = NULL ) ## Similarly, colors for keywords that we might override. keyword_theme_map <- list( - "eclipse" = "#800080", - "clouds" = "#800080" + "eclipse" = "#800080", + "clouds" = "#800080" ) # Needs https://github.com/romainfrancois/css @@ -82,8 +81,16 @@ rstudio_css <- function(theme) { sel, FUN.VALUE = "", function(sel1) { - tail(c(NA_character_, css$value[grepl(sel1, css$rule) & - css$property == "color"]), 1) + tail( + c( + NA_character_, + css$value[ + grepl(sel1, css$rule) & + css$property == "color" + ] + ), + 1 + ) } ) @@ -97,7 +104,10 @@ rstudio_css <- function(theme) { ## Three digit colors are not handled by cli... if (grepl("^#[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]$", col)) { - col <- paste(rep(strsplit(col, "", fixed = TRUE)[[1]], c(1, 2, 2, 2)), collapse = "") + col <- paste( + rep(strsplit(col, "", fixed = TRUE)[[1]], c(1, 2, 2, 2)), + collapse = "" + ) } ## rgb () form if (grepl("^rgb", col)) { @@ -136,29 +146,31 @@ rstudio_css <- function(theme) { list( reserved_ = kw, number_ = g(c("\\.ace_constant\\.ace_numeric$", "\\.ace_constant,")), - null_ = g(c("\\.ace_constant\\.ace_language$", - "\\.ace_variable\\.ace_language$", - "\\.ace_constant,", - "\\.ace_constant\\.ace_buildin")), + null_ = g(c( + "\\.ace_constant\\.ace_language$", + "\\.ace_variable\\.ace_language$", + "\\.ace_constant,", + "\\.ace_constant\\.ace_buildin" + )), operator_ = op, call_ = NA_character_, string_ = g("\\.ace_string$|\\.ace_string,"), comment_ = g("\\.ace_comment$|\\.ace_comment,"), - bracket_ = g(c("\\.ace_paren\\.ace_keyword\\.ace_operator", - "\\.ace_keyword\\.ace_operator", - "\\.ace_keyword")) + bracket_ = g(c( + "\\.ace_paren\\.ace_keyword\\.ace_operator", + "\\.ace_keyword\\.ace_operator", + "\\.ace_keyword" + )) ) } create_rstudio_data <- function() { - themes <- lapply(names(rstudio_theme_details_map), rstudio_css) names(themes) <- names(rstudio_theme_details_map) # Some substitutions for (nm in names(operator_theme_map)) { if (is.null(operator_theme_map[[nm]])) { - } else { themes[[nm]]$null_ <- operator_theme_map[[nm]] themes[[nm]]$operator_ <- operator_theme_map[[nm]] @@ -176,13 +188,13 @@ create_rstudio_data <- function() { themes2 <- lapply(themes, function(theme) { list( reserved = theme$reserved_, - number = theme$number_, - null = theme$null_, + number = theme$number_, + null = theme$null_, operator = theme$operator_, - call = "bold", - string = theme$string_, - comment = theme$comment_, - bracket = list(theme$bracket_, "yellow", "blue", "cyan") + call = "bold", + string = theme$string_, + comment = theme$comment_, + bracket = list(theme$bracket_, "yellow", "blue", "cyan") ) }) diff --git a/tools/parse-iterm.R b/tools/parse-iterm.R index 05d14a9b..5ef503be 100644 --- a/tools/parse-iterm.R +++ b/tools/parse-iterm.R @@ -1,4 +1,3 @@ - parse_iterm <- function(path) { doc <- xml2::read_xml(path) elm <- xml2::xml_find_first(doc, "/plist/dict") @@ -15,7 +14,7 @@ parse_iterm <- function(path) { xml2::xml_find_all(v, "key"), xml2::xml_text ) - if (! "Color Space" %in% vks) stop("Unknown color space") + if (!"Color Space" %in% vks) stop("Unknown color space") chd <- xml2::xml_children(v) csp <- xml2::xml_text( chd[[which(vks == "Color Space") * 2]] @@ -31,22 +30,22 @@ parse_iterm <- function(path) { data.frame( stringsAsFactors = FALSE, row.names = paste0("iterm-", rn), - black = get("Ansi 0 Color"), - red = get("Ansi 1 Color"), - green = get("Ansi 2 Color"), - yellow = get("Ansi 3 Color"), - blue = get("Ansi 4 Color"), - magenta = get("Ansi 5 Color"), - cyan = get("Ansi 6 Color"), - white = get("Ansi 7 Color"), - bblack = get("Ansi 8 Color"), - bred = get("Ansi 9 Color"), - bgreen = get("Ansi 10 Color"), - byellow = get("Ansi 11 Color"), - bblue = get("Ansi 12 Color"), + black = get("Ansi 0 Color"), + red = get("Ansi 1 Color"), + green = get("Ansi 2 Color"), + yellow = get("Ansi 3 Color"), + blue = get("Ansi 4 Color"), + magenta = get("Ansi 5 Color"), + cyan = get("Ansi 6 Color"), + white = get("Ansi 7 Color"), + bblack = get("Ansi 8 Color"), + bred = get("Ansi 9 Color"), + bgreen = get("Ansi 10 Color"), + byellow = get("Ansi 11 Color"), + bblue = get("Ansi 12 Color"), bmagenta = get("Ansi 13 Color"), - bcyan = get("Ansi 14 Color"), - bwhite = get("Ansi 15 Color") + bcyan = get("Ansi 14 Color"), + bwhite = get("Ansi 15 Color") ) } diff --git a/tools/spinners.R b/tools/spinners.R index 889fc6fd..61be96a4 100644 --- a/tools/spinners.R +++ b/tools/spinners.R @@ -1,7 +1,9 @@ - json <- "https://raw.githubusercontent.com/sindresorhus/cli-spinners/45cef9dff64ac5e36b46a194c68bccba448899ac/spinners.json" parsed <- jsonlite::fromJSON(json, simplifyVector = TRUE) -pasis <- lapply(parsed, function(x) { x$frames <- I(x$frames); x }) +pasis <- lapply(parsed, function(x) { + x$frames <- I(x$frames) + x +}) pdt <- as.data.frame(do.call(rbind, pasis)) pdt$name <- rownames(pdt) rownames(pdt) <- NULL @@ -9,8 +11,24 @@ spinners <- pdt[, c("name", "interval", "frames")] usethis::use_data(spinners, internal = TRUE) spinners <- rbind( spinners, - list(name = "growVeriticalDotsLR", interval = 80, frames = strsplit("⠀⡀⣀⣄⣤⣦⣶⣷⣿⣾⣶⣴⣤⣠⣀⢀", "", fixed = TRUE)), - list(name = "growVeriticalDotsRL", interval = 80, frames = strsplit("⠀⢀⣀⣠⣤⣴⣶⣾⣿⣷⣶⣦⣤⣄⣀⡀", "", fixed = TRUE)), - list(name = "growVeriticalDotsLL", interval = 80, frames = strsplit("⠀⡀⣀⣄⣤⣦⣶⣷⣿⣷⣶⣦⣤⣄⣀⡀", "", fixed = TRUE)), - list(name = "growVeriticalDotsRR", interval = 80, frames = strsplit("⠀⡀⣀⣠⣤⣴⣶⣾⣿⣾⣶⣴⣤⣠⣀⢀", "", fixed = TRUE)) + list( + name = "growVeriticalDotsLR", + interval = 80, + frames = strsplit("⠀⡀⣀⣄⣤⣦⣶⣷⣿⣾⣶⣴⣤⣠⣀⢀", "", fixed = TRUE) + ), + list( + name = "growVeriticalDotsRL", + interval = 80, + frames = strsplit("⠀⢀⣀⣠⣤⣴⣶⣾⣿⣷⣶⣦⣤⣄⣀⡀", "", fixed = TRUE) + ), + list( + name = "growVeriticalDotsLL", + interval = 80, + frames = strsplit("⠀⡀⣀⣄⣤⣦⣶⣷⣿⣷⣶⣦⣤⣄⣀⡀", "", fixed = TRUE) + ), + list( + name = "growVeriticalDotsRR", + interval = 80, + frames = strsplit("⠀⡀⣀⣠⣤⣴⣶⣾⣿⣾⣶⣴⣤⣠⣀⢀", "", fixed = TRUE) + ) ) From eebbf273fddbbd7d979b6eceafcf391d226ac205 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?G=C3=A1bor=20Cs=C3=A1rdi?= Date: Fri, 25 Apr 2025 15:47:24 +0200 Subject: [PATCH 03/12] Switch to the base pipe --- R/simple-theme.R | 4 ++-- R/themes.R | 4 ++-- man/builtin_theme.Rd | 8 ++++---- man/simple_theme.Rd | 8 ++++---- 4 files changed, 12 insertions(+), 12 deletions(-) diff --git a/R/simple-theme.R b/R/simple-theme.R index c0e05d13..d6f27d4b 100644 --- a/R/simple-theme.R +++ b/R/simple-theme.R @@ -48,8 +48,8 @@ #' cli_par(class = "code R") #' cli_verbatim( #' '# window functions are useful for grouped mutates', -#' 'mtcars %>%', -#' ' group_by(cyl) %>%', +#' 'mtcars |>', +#' ' group_by(cyl) |>', #' ' mutate(rank = min_rank(desc(mpg)))') #' #' cli_end(show) diff --git a/R/themes.R b/R/themes.R index 931b9c58..0c913d7f 100644 --- a/R/themes.R +++ b/R/themes.R @@ -72,8 +72,8 @@ clii_remove_theme <- function(app, id) { #' cli_par(class = "code R") #' cli_verbatim( #' '# window functions are useful for grouped mutates', -#' 'mtcars %>%', -#' ' group_by(cyl) %>%', +#' 'mtcars |>', +#' ' group_by(cyl) |>', #' ' mutate(rank = min_rank(desc(mpg)))') #' ``` #' diff --git a/man/builtin_theme.Rd b/man/builtin_theme.Rd index fdd94853..788e971f 100644 --- a/man/builtin_theme.Rd +++ b/man/builtin_theme.Rd @@ -48,8 +48,8 @@ cli_h2("Longer code chunk") cli_par(class = "code R") cli_verbatim( '# window functions are useful for grouped mutates', - 'mtcars \%>\%', - ' group_by(cyl) \%>\%', + 'mtcars |>', + ' group_by(cyl) |>', ' mutate(rank = min_rank(desc(mpg)))') }\if{html}{\out{}}\if{html}{\out{ 
@@ -75,8 +75,8 @@ cli_verbatim(
 #> ── Longer code chunk ──                                                         
 #>                                                                                 
 #> # window functions are useful for grouped mutates                               
-#> mtcars %>%                                                                      
-#>   group_by(cyl) %>%                                                             
+#> mtcars |>                                                                       
+#>   group_by(cyl) |>                                                              
 #>   mutate(rank = min_rank(desc(mpg)))
}} diff --git a/man/simple_theme.Rd b/man/simple_theme.Rd index bf462f70..dc93507d 100644 --- a/man/simple_theme.Rd +++ b/man/simple_theme.Rd @@ -58,8 +58,8 @@ cli_h2("Longer code chunk") cli_par(class = "code R") cli_verbatim( '# window functions are useful for grouped mutates', - 'mtcars \%>\%', - ' group_by(cyl) \%>\%', + 'mtcars |>', + ' group_by(cyl) |>', ' mutate(rank = min_rank(desc(mpg)))') cli_end(show) @@ -87,8 +87,8 @@ cli_end(show) #> #> ─ Longer code chunk ── #> # window functions are useful for grouped mutates -#> mtcars %>% -#> group_by(cyl) %>% +#> mtcars |> +#> group_by(cyl) |> #> mutate(rank = min_rank(desc(mpg))) #> From d045fa60319078a715ca13bdf66459d0754b4098 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?G=C3=A1bor=20Cs=C3=A1rdi?= Date: Fri, 25 Apr 2025 15:48:33 +0200 Subject: [PATCH 04/12] Add ROR for Posit in DESCRIPTION --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 511d959c..d1bf567a 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -7,7 +7,7 @@ Authors@R: c( person("Kirill", "Müller", role = "ctb"), person("Salim", "Brüggemann", , "salim-b@pm.me", role = "ctb", comment = c(ORCID = "0000-0002-5329-5987")), - person("Posit Software, PBC", role = c("cph", "fnd")) + person("Posit Software, PBC", role = c("cph", "fnd"), comment = c(ROR = "03wc8by49")) ) Description: A suite of tools to build attractive command line interfaces ('CLIs'), from semantic elements: headings, lists, alerts, paragraphs, From cc03c673e9463faad639148c6bb860745733577d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?G=C3=A1bor=20Cs=C3=A1rdi?= Date: Fri, 25 Apr 2025 18:05:42 +0200 Subject: [PATCH 05/12] Code formatting --- tests/testthat/test-rules.R | 12 ++++-------- tests/testthat/test-utils.R | 5 +---- 2 files changed, 5 insertions(+), 12 deletions(-) diff --git a/tests/testthat/test-rules.R b/tests/testthat/test-rules.R index c85b5432..763f4267 100644 --- a/tests/testthat/test-rules.R +++ b/tests/testthat/test-rules.R @@ -42,14 +42,10 @@ test_that("left label", { }) test_that("centered label", { - expect_error( - rule(left = "label", center = "label"), - "cannot be specified" - ) - expect_error( - rule(center = "label", right = "label"), - "cannot be specified" - ) + expect_snapshot(error = TRUE, { + rule(left = "label", center = "label") + rule(center = "label", right = "label") + }) expect_equal( rule(center = "label", width = 13, line = "-"), diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index 7f921b38..42049e23 100644 --- a/tests/testthat/test-utils.R +++ b/tests/testthat/test-utils.R @@ -9,10 +9,7 @@ test_that("make_space", { }) test_that("apply_style", { - expect_error( - apply_style("text", raw(0)), - "must be a color name or an ANSI style function" - ) + expect_snapshot(error = TRUE, apply_style("text", raw(0))) expect_equal( apply_style("foo", function(x) toupper(x)), "FOO" From 729adc2095a3e530fe650d112e9ef791c5e269f1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?G=C3=A1bor=20Cs=C3=A1rdi?= Date: Fri, 25 Apr 2025 18:06:07 +0200 Subject: [PATCH 06/12] `knitr::convert_chunk_header(type = "yaml")` --- vignettes/ansi-benchmark.Rmd | 10 +++- vignettes/palettes.Rmd | 72 +++++++++++++++++------ vignettes/pluralization.Rmd | 3 +- vignettes/progress-advanced.Rmd | 92 ++++++++++++++++++++--------- vignettes/progress-benchmark.Rmd | 99 +++++++++++++++++++++----------- vignettes/progress.Rmd | 49 +++++++++++----- vignettes/semantic-cli.Rmd | 7 ++- vignettes/usethis-ui.Rmd | 10 +++- 8 files changed, 242 insertions(+), 100 deletions(-) diff --git a/vignettes/ansi-benchmark.Rmd b/vignettes/ansi-benchmark.Rmd index 2eadd56e..7d1750dd 100644 --- a/vignettes/ansi-benchmark.Rmd +++ b/vignettes/ansi-benchmark.Rmd @@ -11,7 +11,10 @@ editor_options: wrap: sentence --- -```{r, setup, include = FALSE, cache = FALSE} +```{r} +#| label: setup +#| include: false +#| cache: false knitr::opts_chunk$set( collapse = TRUE, comment = "#>", @@ -20,7 +23,10 @@ knitr::opts_chunk$set( ) ``` -```{r comment = "", results = 'asis', echo = FALSE} +```{r} +#| comment: '' +#| results: asis +#| echo: false fansi::set_knit_hooks( knitr::knit_hooks, which = "output" diff --git a/vignettes/palettes.Rmd b/vignettes/palettes.Rmd index 840fdcce..dd595bfa 100644 --- a/vignettes/palettes.Rmd +++ b/vignettes/palettes.Rmd @@ -10,7 +10,9 @@ editor_options: wrap: sentence --- -```{r, include = FALSE, cache = FALSE} +```{r} +#| include: false +#| cache: false knitr::opts_chunk$set( collapse = TRUE, comment = "#>", @@ -35,7 +37,9 @@ This vignette demonstrates what the various palettes included in the package loo ## `dichro` -```{r, results = "asis", echo = FALSE} +```{r} +#| results: asis +#| echo: false cat(attr(cli::ansi_palettes, "info")$dichro) ``` @@ -52,7 +56,9 @@ ansi_palette_show("dichro", colors = truecolor) ## `vga` -```{r, results = "asis", echo = FALSE} +```{r} +#| results: asis +#| echo: false cat(attr(cli::ansi_palettes, "info")$vga) ``` @@ -69,7 +75,9 @@ ansi_palette_show("vga", colors = truecolor) ## `winxp` -```{r, results = "asis", echo = FALSE} +```{r} +#| results: asis +#| echo: false cat(attr(cli::ansi_palettes, "info")$winxp) ``` @@ -86,7 +94,9 @@ ansi_palette_show("winxp", colors = truecolor) ## `vscode` -```{r, results = "asis", echo = FALSE} +```{r} +#| results: asis +#| echo: false cat(attr(cli::ansi_palettes, "info")$vscode) ``` @@ -103,7 +113,9 @@ ansi_palette_show("vscode", colors = truecolor) ## `win10` -```{r, results = "asis", echo = FALSE} +```{r} +#| results: asis +#| echo: false cat(attr(cli::ansi_palettes, "info")$win10) ``` @@ -120,7 +132,9 @@ ansi_palette_show("win10", colors = truecolor) ## `macos` -```{r, results = "asis", echo = FALSE} +```{r} +#| results: asis +#| echo: false cat(attr(cli::ansi_palettes, "info")$macos) ``` @@ -137,7 +151,9 @@ ansi_palette_show("macos", colors = truecolor) ## `putty` -```{r, results = "asis", echo = FALSE} +```{r} +#| results: asis +#| echo: false cat(attr(cli::ansi_palettes, "info")$putty) ``` @@ -154,7 +170,9 @@ ansi_palette_show("putty", colors = truecolor) ## `mirc` -```{r, results = "asis", echo = FALSE} +```{r} +#| results: asis +#| echo: false cat(attr(cli::ansi_palettes, "info")$mirc) ``` @@ -171,7 +189,9 @@ ansi_palette_show("mirc", colors = truecolor) ## `xterm` -```{r, results = "asis", echo = FALSE} +```{r} +#| results: asis +#| echo: false cat(attr(cli::ansi_palettes, "info")$xterm) ``` @@ -188,7 +208,9 @@ ansi_palette_show("xterm", colors = truecolor) ## `ubuntu` -```{r, results = "asis", echo = FALSE} +```{r} +#| results: asis +#| echo: false cat(attr(cli::ansi_palettes, "info")$ubuntu) ``` @@ -205,7 +227,9 @@ ansi_palette_show("ubuntu", colors = truecolor) ## `eclipse` -```{r, results = "asis", echo = FALSE} +```{r} +#| results: asis +#| echo: false cat(attr(cli::ansi_palettes, "info")$eclipse) ``` @@ -222,7 +246,9 @@ ansi_palette_show("eclipse", colors = truecolor) ## `iterm` -```{r, results = "asis", echo = FALSE} +```{r} +#| results: asis +#| echo: false cat(attr(cli::ansi_palettes, "info")$iterm) ``` @@ -239,7 +265,9 @@ ansi_palette_show("iterm", colors = truecolor) ## `iterm-pastel` -```{r, results = "asis", echo = FALSE} +```{r} +#| results: asis +#| echo: false cat(attr(cli::ansi_palettes, "info")$`iterm-pastel`) ``` @@ -256,7 +284,9 @@ ansi_palette_show("iterm-pastel", colors = truecolor) ## `iterm-smoooooth` -```{r, results = "asis", echo = FALSE} +```{r} +#| results: asis +#| echo: false cat(attr(cli::ansi_palettes, "info")$`iterm-smoooooth`) ``` @@ -273,7 +303,9 @@ ansi_palette_show("iterm-smoooooth", colors = truecolor) ## `iterm-snazzy` -```{r, results = "asis", echo = FALSE} +```{r} +#| results: asis +#| echo: false cat(attr(cli::ansi_palettes, "info")$`iterm-snazzy`) ``` @@ -290,7 +322,9 @@ ansi_palette_show("iterm-snazzy", colors = truecolor) ## `iterm-solarized` -```{r, results = "asis", echo = FALSE} +```{r} +#| results: asis +#| echo: false cat(attr(cli::ansi_palettes, "info")$`iterm-solarized`) ``` @@ -307,7 +341,9 @@ ansi_palette_show("iterm-solarized", colors = truecolor) ## `iterm-tango` -```{r, results = "asis", echo = FALSE} +```{r} +#| results: asis +#| echo: false cat(attr(cli::ansi_palettes, "info")$`iterm-tango`) ``` diff --git a/vignettes/pluralization.Rmd b/vignettes/pluralization.Rmd index e5bbc0a2..aba4b8eb 100644 --- a/vignettes/pluralization.Rmd +++ b/vignettes/pluralization.Rmd @@ -7,5 +7,6 @@ date: "`r Sys.Date()`" output: rmarkdown::html_document --- -```{r child = "../man/chunks/pluralization.Rmd"} + +```{r child= "../man/chunks/pluralization.Rmd"} ``` diff --git a/vignettes/progress-advanced.Rmd b/vignettes/progress-advanced.Rmd index ed2d425a..a0e40110 100644 --- a/vignettes/progress-advanced.Rmd +++ b/vignettes/progress-advanced.Rmd @@ -13,7 +13,9 @@ editor_options: wrap: sentence --- -```{r, include = FALSE, cache = FALSE} +```{r} +#| include: false +#| cache: false knitr::opts_chunk$set( collapse = TRUE, comment = "#>", @@ -29,7 +31,10 @@ asciicast::init_knitr_engine( ) ``` -```{asciicast, setup, cache = FALSE, include = FALSE} +```{asciicast} +#| label: setup +#| cache: false +#| include: false library(cli) options(cli.progress_show_after = 0) options(cli.progress_clear = FALSE) @@ -130,11 +135,13 @@ default display, with known and unknown number of total progress units. Typically for loops and mapping functions. It shows a bar by default, if the total number of iterations is known. -```{asciicast echo = FALSE} +```{asciicast} +#| echo: false cli_progress_demo("Data cleaning", total = 100, at = 50, clear = FALSE) ``` -```{asciicast echo = FALSE} +```{asciicast} +#| echo: false cli_progress_demo("Data cleaning", at = 50, clear = FALSE) ``` @@ -142,14 +149,16 @@ cli_progress_demo("Data cleaning", at = 50, clear = FALSE) For a list of tasks, by default it shows a `current/total` display. -```{asciicast echo = FALSE} +```{asciicast} +#| echo: false cli_progress_demo( "Finding data files", total = 100, at = 50, clear = FALSE, type = "tasks" ) ``` -```{asciicast echo = FALSE} +```{asciicast} +#| echo: false cli_progress_demo( "Finding data files", at = 50, clear = FALSE, type = "tasks" @@ -160,14 +169,16 @@ cli_progress_demo( For downloads, progress units are shown as bytes by default here. -```{asciicast echo = FALSE} +```{asciicast} +#| echo: false cli_progress_demo( "Downloading", total = 10280, at = 5120, clear = FALSE, type = "download" ) ``` -```{asciicast echo = FALSE} +```{asciicast} +#| echo: false cli_progress_demo( "Downloading", at = 5120, clear = FALSE, type = "download" @@ -187,7 +198,7 @@ templating, cli pluralization and cli theming. They can also use a number of built-in cli progress variables, see 'Progress variables' below. ```{asciicast} -#| asciicast_at = "all" +#| asciicast_at: "all" f <- function() { cli_progress_bar( total = 20000, @@ -233,7 +244,8 @@ Otherwise `cli.progress_bar_style` is used. On non UTF-8 displays These options can be set to a built-in progress bar style name: -```{r include = FALSE} +```{r} +#| include: false library(cli) ``` @@ -242,13 +254,15 @@ names(cli_progress_styles()) ``` ```{asciicast} -#| asciicast_at = "all" +#| asciicast_at: "all" options(cli.progress_bar_style = "fillsquares") f <- function() lapply(cli_progress_along(letters), function(l) Sys.sleep(0.2)) x <- f() ``` -```{asciicast include = FALSE, cache = FALSE} +```{asciicast} +#| include: false +#| cache: false options(cli.progress_bar_style = NULL) ``` @@ -257,7 +271,7 @@ Alternatively, they can be set to a list with entries `complete`, parts of the progress bar: ```{asciicast} -#| asciicast_at = "all" +#| asciicast_at: "all" options(cli.progress_bar_style = list( complete = cli::col_yellow("\u2605"), incomplete = cli::col_grey("\u00b7") @@ -266,8 +280,9 @@ f <- function() lapply(cli_progress_along(letters), function(l) Sys.sleep(0.2)) x <- f() ``` -```{asciicast include = FALSE} -#| asciicast_at = "all" +```{asciicast} +#| include: false +#| asciicast_at: "all" options(cli.progress_bar_style = NULL) ``` @@ -286,8 +301,9 @@ otherwise `cli.spinner`. Use `list_spinners()` to list all spinners and `demo_spinners()` to take a peek at them. -```{asciicast custom-spinner} -#| asciicast_at = "all" +```{asciicast} +#| label: custom-spinner +#| asciicast_at: "all" options(cli.spinner = "moon") f <- function() { cli_progress_bar(format = strrep("{cli::pb_spin} ", 20), clear = TRUE) @@ -327,8 +343,11 @@ format string as an end user option, we suggest that you always use the qualified form, in case the cli package is not attached. For example, to set a minimal display for downloads you might write -```{asciicast download, include = FALSE, cache = FALSE} -#| asciicast_at = "end", +```{asciicast} +#| label: download +#| include: false +#| cache: false +#| asciicast_at: "end" options(cli.progress_format_download = paste0( "{cli::col_cyan('\u2B07')} {cli::pb_spin} ", @@ -337,13 +356,24 @@ options(cli.progress_format_download = ) ``` -```{asciicast eval = FALSE} -<> +```{asciicast} +#| eval: false +#| label: download2 +#| include: false +#| cache: false +#| asciicast_at: "end" +options(cli.progress_format_download = + paste0( + "{cli::col_cyan('\u2B07')} {cli::pb_spin} ", + "{cli::pb_name}[{cli::pb_current_bytes}/{cli::pb_total_bytes}]" + ) +) ``` to get -```{asciicast, echo = FALSE} +```{asciicast} +#| echo: false cli_progress_demo( "Downloading", total = 10280, at = 5121, clear = FALSE, type = "download" @@ -354,8 +384,9 @@ You can use your own expressions and functions on progress bar tokens. E.g. to show the current number of steps with letters instead of numbers, use `letters[pb_current]`: -```{asciicast function-of-token} -#| asciicast_at = "all" +```{asciicast} +#| label: function-of-token +#| asciicast_at: "all" f <- function() { cli_progress_bar( total = 26, @@ -401,7 +432,8 @@ traditional R API: A complete example: -```{asciicastcpp11 capi} +```{asciicastcpp11} +#| label: capi #include SEXP progress_test1() { int i; @@ -416,12 +448,16 @@ SEXP progress_test1() { } ``` -```{asciicast, echo = FALSE, dependson = -1} -#| asciicast_at = "all" +```{asciicast} +#| echo: false +#| asciicast_at: "all" invisible(progress_test1()) ``` ## C API reference -```{r include = FALSE, cache = FALSE, child = cli:::docs_progress_c_api()} +```{r} +#| include: false +#| cache: false +#| child: !expr cli:::docs_progress_c_api() ``` diff --git a/vignettes/progress-benchmark.Rmd b/vignettes/progress-benchmark.Rmd index 21319498..3c8affba 100644 --- a/vignettes/progress-benchmark.Rmd +++ b/vignettes/progress-benchmark.Rmd @@ -11,7 +11,10 @@ editor_options: wrap: sentence --- -```{r, setup, include = FALSE, cache = FALSE} +```{r} +#| label: setup +#| include: false +#| cache: false knitr::opts_chunk$set( collapse = TRUE, comment = "#>", @@ -24,7 +27,9 @@ knitr::opts_chunk$set( We make sure that the timer is not `TRUE`, by setting it to ten hours. -```{r library, cache = FALSE} +```{r} +#| label: library +#| cache: false library(cli) # 10 hours cli:::cli_tick_set(10 * 60 * 60 * 1000) @@ -36,7 +41,8 @@ cli_tick_reset() ## The timer -```{r timer} +```{r} +#| label: timer fun <- function() NULL ben_st <- bench::mark( `__cli_update_due`, @@ -48,7 +54,8 @@ ben_st <- bench::mark( ben_st ``` -```{r timer2} +```{r} +#| label: timer2 ben_st2 <- bench::mark( if (`__cli_update_due`) foobar() ) @@ -57,7 +64,8 @@ ben_st2 ## `cli_progress_along()` -```{r tick-along} +```{r} +#| label: tick-along seq <- 1:100000 ta <- cli_progress_along(seq) bench::mark(seq[[1]], ta[[1]]) @@ -67,7 +75,8 @@ bench::mark(seq[[1]], ta[[1]]) This is the baseline: -```{r tick-along-for-f0} +```{r} +#| label: tick-along-for-f0 f0 <- function(n = 1e5) { x <- 0 seq <- 1:n @@ -80,7 +89,8 @@ f0 <- function(n = 1e5) { With progress bars: -```{r tick-along-for-f} +```{r} +#| label: tick-along-for-f fp <- function(n = 1e5) { x <- 0 seq <- 1:n @@ -94,25 +104,29 @@ fp <- function(n = 1e5) { Overhead per iteration: -```{r tick-along-for-bench} +```{r} +#| label: tick-along-for-bench ben_taf <- bench::mark(f0(), fp()) ben_taf (ben_taf$median[2] - ben_taf$median[1]) / 1e5 ``` -```{r tick-along-for-bench2} +```{r} +#| label: tick-along-for-bench2 ben_taf2 <- bench::mark(f0(1e6), fp(1e6)) ben_taf2 (ben_taf2$median[2] - ben_taf2$median[1]) / 1e6 ``` -```{r tick-along-for-bench3} +```{r} +#| label: tick-along-for-bench3 ben_taf3 <- bench::mark(f0(1e7), fp(1e7)) ben_taf3 (ben_taf3$median[2] - ben_taf3$median[1]) / 1e7 ``` -```{r tick-along-for-bench4} +```{r} +#| label: tick-along-for-bench4 ben_taf4 <- bench::mark(f0(1e8), fp(1e8)) ben_taf4 (ben_taf4$median[2] - ben_taf4$median[1]) / 1e8 @@ -122,7 +136,8 @@ ben_taf4 This is the baseline: -```{r tick-along-map-f0} +```{r} +#| label: tick-along-map-f0 f0 <- function(n = 1e5) { seq <- 1:n ret <- lapply(seq, function(x) { @@ -134,7 +149,8 @@ f0 <- function(n = 1e5) { With an index vector: -```{r tick-along-map-f01} +```{r} +#| label: tick-along-map-f01 f01 <- function(n = 1e5) { seq <- 1:n ret <- lapply(seq_along(seq), function(i) { @@ -146,7 +162,8 @@ f01 <- function(n = 1e5) { With progress bars: -```{r tick-along-map-f} +```{r} +#| label: tick-along-map-f fp <- function(n = 1e5) { seq <- 1:n ret <- lapply(cli_progress_along(seq), function(i) { @@ -157,13 +174,15 @@ fp <- function(n = 1e5) { ``` Overhead per iteration: -```{r tick-along-map-bench} +```{r} +#| label: tick-along-map-bench ben_tam <- bench::mark(f0(), f01(), fp()) ben_tam (ben_tam$median[3] - ben_tam$median[1]) / 1e5 ``` -```{r tick-along-map-bench2} +```{r} +#| label: tick-along-map-bench2 ben_tam2 <- bench::mark(f0(1e6), f01(1e6), fp(1e6)) ben_tam2 (ben_tam2$median[3] - ben_tam2$median[1]) / 1e6 @@ -174,7 +193,8 @@ ben_tam2 This is the baseline: -```{r tick-along-purrr-f0} +```{r} +#| label: tick-along-purrr-f0 f0 <- function(n = 1e5) { seq <- 1:n ret <- purrr::map(seq, function(x) { @@ -186,7 +206,8 @@ f0 <- function(n = 1e5) { With index vector: -```{r tick-along-purrr-f01} +```{r} +#| label: tick-along-purrr-f01 f01 <- function(n = 1e5) { seq <- 1:n ret <- purrr::map(seq_along(seq), function(i) { @@ -198,7 +219,8 @@ f01 <- function(n = 1e5) { With progress bars: -```{r tick-along-purrr-f} +```{r} +#| label: tick-along-purrr-f fp <- function(n = 1e5) { seq <- 1:n ret <- purrr::map(cli_progress_along(seq), function(i) { @@ -210,14 +232,16 @@ fp <- function(n = 1e5) { Overhead per iteration: -```{r tick-along-purrr-bench} +```{r} +#| label: tick-along-purrr-bench ben_pur <- bench::mark(f0(), f01(), fp()) ben_pur (ben_pur$median[3] - ben_pur$median[1]) / 1e5 (ben_pur$median[3] - ben_pur$median[2]) / 1e5 ``` -```{r tick-along-purrr-bench2} +```{r} +#| label: tick-along-purrr-bench2 ben_pur2 <- bench::mark(f0(1e6), f01(1e6), fp(1e6)) ben_pur2 (ben_pur2$median[3] - ben_pur2$median[1]) / 1e6 @@ -226,7 +250,8 @@ ben_pur2 ## `ticking()` -```{r ticking-f0} +```{r} +#| label: ticking-f0 f0 <- function(n = 1e5) { i <- 0 x <- 0 @@ -238,7 +263,8 @@ f0 <- function(n = 1e5) { } ``` -```{r ticking-fp} +```{r} +#| label: ticking-fp fp <- function(n = 1e5) { i <- 0 x <- 0 @@ -250,7 +276,8 @@ fp <- function(n = 1e5) { } ``` -```{r ticking} +```{r} +#| label: ticking ben_tk <- bench::mark(f0(), fp()) ben_tk (ben_tk$median[2] - ben_tk$median[1]) / 1e5 @@ -258,7 +285,8 @@ ben_tk ## Traditional API -```{r api-f0} +```{r} +#| label: api-f0 f0 <- function(n = 1e5) { x <- 0 for (i in 1:n) { @@ -268,7 +296,8 @@ f0 <- function(n = 1e5) { } ``` -```{r api-fp} +```{r} +#| label: api-fp fp <- function(n = 1e5) { cli_progress_bar(total = n) x <- 0 @@ -280,7 +309,8 @@ fp <- function(n = 1e5) { } ``` -```{r api-fpfast} +```{r} +#| label: api-fpfast ff <- function(n = 1e5) { cli_progress_bar(total = n) x <- 0 @@ -292,14 +322,16 @@ ff <- function(n = 1e5) { } ``` -```{r api} +```{r} +#| label: api ben_api <- bench::mark(f0(), ff(), fp()) ben_api (ben_api$median[3] - ben_api$median[1]) / 1e5 (ben_api$median[2] - ben_api$median[1]) / 1e5 ``` -```{r api2} +```{r} +#| label: api2 ben_api2 <- bench::mark(f0(1e6), ff(1e6), fp(1e6)) ben_api2 (ben_api2$median[3] - ben_api2$median[1]) / 1e6 @@ -372,7 +404,8 @@ SEXP test_cli_unroll() { } ``` -```{r capi} +```{r} +#| label: capi library(progresstest) ben_c <- bench::mark( test_baseline(), @@ -393,7 +426,8 @@ Let's measure how long a single update takes. ## Iterator with a bar -```{r update-prep-total} +```{r} +#| label: update-prep-total cli_progress_bar(total = 100000) bench::mark(cli_progress_update(force = TRUE), max_iterations = 10000) cli_progress_done() @@ -401,7 +435,8 @@ cli_progress_done() ## Iterator without a bar -```{r update-prep-nototal} +```{r} +#| label: update-prep-nototal cli_progress_bar(total = NA) bench::mark(cli_progress_update(force = TRUE), max_iterations = 10000) cli_progress_done() diff --git a/vignettes/progress.Rmd b/vignettes/progress.Rmd index 7b4b00ec..66a5ce90 100644 --- a/vignettes/progress.Rmd +++ b/vignettes/progress.Rmd @@ -13,7 +13,10 @@ editor_options: wrap: sentence --- -```{r, asciicast-setup, include = FALSE, cache = FALSE} +```{r} +#| label: asciicast-setup +#| include: false +#| cache: false knitr::opts_chunk$set( collapse = TRUE, comment = "#>", @@ -30,12 +33,18 @@ asciicast::init_knitr_engine( # Introduction -```{asciicast, asciicast-tick-time, include = FALSE, cache = FALSE} +```{asciicast} +#| label: asciicast-tick-time +#| include: false +#| cache: false set.seed(1) Sys.setenv(CLI_TICK_TIME = "100") ``` -```{asciicast, progress-setup setup, cache = FALSE, include = FALSE} +```{asciicast} +#| label: progress-setup setup +#| cache: false +#| include: false library(cli) options(cli.progress_show_after = 0) options(cli.progress_clear = FALSE) @@ -76,7 +85,8 @@ Add a progress bar in three steps: For example: -```{asciicast classic-example} +```{asciicast} +#| label: classic-example clean <- function() { cli_progress_bar("Cleaning data", total = 100) for (i in 1:100) { @@ -101,7 +111,8 @@ or is interrupted. The current progress bar lets us omit the `cli_progress_done()` call: -```{asciicast current} +```{asciicast} +#| label: current clean <- function() { cli_progress_bar("Cleaning data #1", total = 100) for (i in 1:100) { @@ -124,11 +135,15 @@ In some cases the total number of progress units is unknown, so simply omit them from `cli_progress_bar()` (or set them to `NA`). cli uses a different display when `total` is unknown: -```{asciicast unknown-total-seed, include = FALSE, cache = FALSE} +```{asciicast} +#| label: unknown-total-seed +#| include: false +#| cache: false set.seed(1) ``` -```{asciicast unknown-total} +```{asciicast} +#| label: unknown-total walk_dirs <- function() { cli_progress_bar("Walking directories") while (TRUE) { @@ -171,7 +186,8 @@ from beginning to end. It is best to never assign the return value of An example: -```{asciicast, tickalong} +```{asciicast} +#| label: tickalong f <- function() { rawabc <- lapply( cli_progress_along(letters), @@ -233,7 +249,8 @@ default: * A status message removes the previous status message or progress bar of the same caller function. -```{asciicast cli_progress_message} +```{asciicast} +#| label: cli_progress_message f <- function() { cli_progress_message("Task one is running...") Sys.sleep(2) @@ -261,7 +278,8 @@ as usual. You can call `cli_progress_update()` to update a status message. * prints the duration of each step (by default), and * it keeps the messages on the screen after they are terminated. -```{asciicast cli_progress_step_simple} +```{asciicast} +#| label: cli_progress_step_simple f <- function() { cli_progress_step("Downloading data") Sys.sleep(2) @@ -281,7 +299,8 @@ f() As usual, you can use `cli_progress_step()` to update an existing status message. -```{asciicast cli_progress_step} +```{asciicast} +#| label: cli_progress_step f <- function(n = 10) { cli_alert_info("About to start downloads of {n} file{?s}") i <- 0 @@ -298,7 +317,8 @@ f() If you can update the status message frequently enough, then you can also add a spinner to it: -```{asciicast cli_progress_step_spinner} +```{asciicast} +#| label: cli_progress_step_spinner f <- function() { cli_progress_step("Downloading data", spinner = TRUE) for (i in 1:100) { cli_progress_update(); Sys.sleep(2/100) } @@ -315,8 +335,9 @@ f() `cli_progress_step()` automatically handles errors, and styles the status message accordingly: -```{asciicast step-error} -#| asciicast_rows = 3 +```{asciicast} +#| label: step-error +#| asciicast_rows: 3 f <- function() { cli_progress_step("First step, this will succeed") Sys.sleep(1) diff --git a/vignettes/semantic-cli.Rmd b/vignettes/semantic-cli.Rmd index 20d21abf..67a1d425 100644 --- a/vignettes/semantic-cli.Rmd +++ b/vignettes/semantic-cli.Rmd @@ -14,7 +14,9 @@ editor_options: wrap: sentence --- -```{r, include = FALSE, cache = FALSE} +```{r} +#| include: false +#| cache: false knitr::opts_chunk$set( collapse = TRUE, comment = "#>", @@ -49,7 +51,8 @@ CLI elements, and also some common features of them. # Building a command line interface -```{r, setup} +```{r} +#| label: setup library(cli) ``` diff --git a/vignettes/usethis-ui.Rmd b/vignettes/usethis-ui.Rmd index 97aca7dc..fec63fcc 100644 --- a/vignettes/usethis-ui.Rmd +++ b/vignettes/usethis-ui.Rmd @@ -13,7 +13,9 @@ editor_options: wrap: sentence --- -```{r, include = FALSE, cache = FALSE} +```{r} +#| include: false +#| cache: false knitr::opts_chunk$set( collapse = TRUE, comment = "#>", @@ -33,7 +35,8 @@ asciicast::init_knitr_engine( # Introduction -```{r setup} +```{r} +#| label: setup library(cli) library(usethis) ``` @@ -76,7 +79,8 @@ cli_ul("Redocument with {.fun devtools::document}") ### Example -```{asciicast, asciicast_rows = length(format(cli::cli_code)) + 2} +```{asciicast} +#| asciicast_rows: !expr length(format(cli::cli_code)) + 2 ui_code_block("{format(cli_code)}") ``` From 519382532fd19e00507ba302b0695fde5a14abc8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?G=C3=A1bor=20Cs=C3=A1rdi?= Date: Fri, 25 Apr 2025 18:51:01 +0200 Subject: [PATCH 07/12] Switch to expect_snapshot(error = TRUE) --- tests/testthat/_snaps/ansi-hyperlink.md | 8 + tests/testthat/_snaps/assertions.md | 248 ++++++++++++++++++++++ tests/testthat/_snaps/diff.md | 27 +++ tests/testthat/_snaps/pluralization.md | 23 ++ tests/testthat/_snaps/progress-along.md | 10 + tests/testthat/_snaps/progress-c.md | 32 +++ tests/testthat/_snaps/progress-client.md | 40 ++++ tests/testthat/_snaps/progress-message.md | 30 +++ tests/testthat/_snaps/rules.md | 13 ++ tests/testthat/_snaps/substitution.md | 19 ++ tests/testthat/_snaps/utils.md | 9 + tests/testthat/helper.R | 4 + tests/testthat/test-ansi-hyperlink.R | 2 +- tests/testthat/test-assertions.R | 30 +-- tests/testthat/test-diff.R | 19 +- tests/testthat/test-pluralization.R | 22 +- tests/testthat/test-progress-along.R | 2 +- tests/testthat/test-progress-c.R | 28 ++- tests/testthat/test-progress-client.R | 16 +- tests/testthat/test-progress-message.R | 12 +- tests/testthat/test-substitution.R | 6 +- 21 files changed, 518 insertions(+), 82 deletions(-) create mode 100644 tests/testthat/_snaps/assertions.md create mode 100644 tests/testthat/_snaps/substitution.md diff --git a/tests/testthat/_snaps/ansi-hyperlink.md b/tests/testthat/_snaps/ansi-hyperlink.md index b00c2e6e..a6bcf40e 100644 --- a/tests/testthat/_snaps/ansi-hyperlink.md +++ b/tests/testthat/_snaps/ansi-hyperlink.md @@ -59,3 +59,11 @@ Output ]8;;https://example.com\text]8;;\ +# get_config_chr() errors if option is not NULL or string + + Code + get_config_chr("something") + Condition + Error in `get_config_chr()`: + ! is_string(opt) is not TRUE + diff --git a/tests/testthat/_snaps/assertions.md b/tests/testthat/_snaps/assertions.md new file mode 100644 index 00000000..ddda04fc --- /dev/null +++ b/tests/testthat/_snaps/assertions.md @@ -0,0 +1,248 @@ +# is_string + + Code + stopifnot(is_string(n)) + Condition + Error: + ! is_string(n) is not TRUE + +--- + + Code + stopifnot(is_string(n)) + Condition + Error: + ! is_string(n) is not TRUE + +--- + + Code + stopifnot(is_string(n)) + Condition + Error: + ! is_string(n) is not TRUE + +--- + + Code + stopifnot(is_string(n)) + Condition + Error: + ! is_string(n) is not TRUE + +--- + + Code + stopifnot(is_string(n)) + Condition + Error: + ! is_string(n) is not TRUE + +--- + + Code + stopifnot(is_string(n)) + Condition + Error: + ! is_string(n) is not TRUE + +--- + + Code + stopifnot(is_string(n)) + Condition + Error: + ! is_string(n) is not TRUE + +# is_border_style + + Code + stopifnot(is_border_style("blahblahxxx")) + Condition + Error: + ! is_border_style("blahblahxxx") is not TRUE + +# is_padding_or_margin + + Code + stopifnot(is_padding_or_margin(b)) + Condition + Error: + ! is_padding_or_margin(b) is not TRUE + +--- + + Code + stopifnot(is_padding_or_margin(b)) + Condition + Error: + ! is_padding_or_margin(b) is not TRUE + +--- + + Code + stopifnot(is_padding_or_margin(b)) + Condition + Error: + ! is_padding_or_margin(b) is not TRUE + +--- + + Code + stopifnot(is_padding_or_margin(b)) + Condition + Error: + ! is_padding_or_margin(b) is not TRUE + +--- + + Code + stopifnot(is_padding_or_margin(b)) + Condition + Error: + ! is_padding_or_margin(b) is not TRUE + +--- + + Code + stopifnot(is_padding_or_margin(b)) + Condition + Error: + ! is_padding_or_margin(b) is not TRUE + +--- + + Code + stopifnot(is_padding_or_margin(b)) + Condition + Error: + ! is_padding_or_margin(b) is not TRUE + +--- + + Code + stopifnot(is_padding_or_margin(b)) + Condition + Error: + ! is_padding_or_margin(b) is not TRUE + +--- + + Code + stopifnot(is_padding_or_margin(b)) + Condition + Error: + ! is_padding_or_margin(b) is not TRUE + +--- + + Code + stopifnot(is_padding_or_margin(b)) + Condition + Error: + ! is_padding_or_margin(b) is not TRUE + +--- + + Code + stopifnot(is_padding_or_margin(b)) + Condition + Error: + ! is_padding_or_margin(b) is not TRUE + +--- + + Code + stopifnot(is_padding_or_margin(b)) + Condition + Error: + ! is_padding_or_margin(b) is not TRUE + +# is_col + + Code + stopifnot(is_col(b)) + Condition + Error: + ! is_col(b) is not TRUE + +--- + + Code + stopifnot(is_col(b)) + Condition + Error: + ! is_col(b) is not TRUE + +--- + + Code + stopifnot(is_col(b)) + Condition + Error: + ! is_col(b) is not TRUE + +# is_count + + Code + stopifnot(is_count(n)) + Condition + Error: + ! is_count(n) is not TRUE + +--- + + Code + stopifnot(is_count(n)) + Condition + Error: + ! is_count(n) is not TRUE + +--- + + Code + stopifnot(is_count(n)) + Condition + Error: + ! is_count(n) is not TRUE + +--- + + Code + stopifnot(is_count(n)) + Condition + Error: + ! is_count(n) is not TRUE + +--- + + Code + stopifnot(is_count(n)) + Condition + Error: + ! is_count(n) is not TRUE + +--- + + Code + stopifnot(is_count(n)) + Condition + Error: + ! is_count(n) is not TRUE + +--- + + Code + stopifnot(is_count(n)) + Condition + Error: + ! is_count(n) is not TRUE + +--- + + Code + stopifnot(is_count(n)) + Condition + Error: + ! is_count(n) is not TRUE + diff --git a/tests/testthat/_snaps/diff.md b/tests/testthat/_snaps/diff.md index 63d5573c..d401a8de 100644 --- a/tests/testthat/_snaps/diff.md +++ b/tests/testthat/_snaps/diff.md @@ -229,6 +229,33 @@ Output PREabcdefghijklmMIDDLEnopqrstuvwxyzPOST +# warnings and errors + + Code + diff_chr(1:10, 1:10) + Condition + Error in `diff_chr()`: + ! is.character(old) is not TRUE + Code + format(diff_chr("foo", "bar"), context = -1) + Condition + Error in `format.cli_diff_chr()`: + ! context == Inf || is_count(context) is not TRUE + Code + format(diff_chr("foo", "bar"), what = 1, is = 2, this = 3) + Condition + Warning in `format.cli_diff_chr()`: + Extra arguments were ignored in `format.cli_diff_chr()`. + Output + [1] "@@ -1 +1 @@" "-foo" "+bar" + Code + format(diff_str("foo", "bar"), what = 1, is = 2, this = 3) + Condition + Warning in `format.cli_diff_str()`: + Extra arguments were ignored in `format.cli_diff_chr()`. + Output + [1] "[-foo-]{+bar+}" + # max_diff ! Diff edit distance is larger than the limit. diff --git a/tests/testthat/_snaps/pluralization.md b/tests/testthat/_snaps/pluralization.md index e6d3d91e..3ffb2eb0 100644 --- a/tests/testthat/_snaps/pluralization.md +++ b/tests/testthat/_snaps/pluralization.md @@ -161,6 +161,29 @@ Package: pkg1 Packages: pkg1 and pkg2 +# post-processing errors + + Code + cli_text("package{?s}") + Condition + Error in `post_process_plurals()`: + ! Cannot pluralize without a quantity + Code + pluralize("package{?s}") + Condition + Error in `post_process_plurals()`: + ! Cannot pluralize without a quantity + Code + cli_text("package{?s} {5} {10}") + Condition + Error in `post_process_plurals()`: + ! Multiple quantities for pluralization + Code + pluralize("package{?s} {5} {10}") + Condition + Error in `post_process_plurals()`: + ! Multiple quantities for pluralization + # issue 158 Code diff --git a/tests/testthat/_snaps/progress-along.md b/tests/testthat/_snaps/progress-along.md index ea44f3ac..f8c362a1 100644 --- a/tests/testthat/_snaps/progress-along.md +++ b/tests/testthat/_snaps/progress-along.md @@ -27,6 +27,16 @@ # cli_progress_along error + Code + callr::r(fun, stdout = outfile, stderr = outfile) + Condition + Error: + ! in callr subprocess. + Caused by error: + ! oops + +--- + Code lines Output diff --git a/tests/testthat/_snaps/progress-c.md b/tests/testthat/_snaps/progress-c.md index 2d430533..d26fecf6 100644 --- a/tests/testthat/_snaps/progress-c.md +++ b/tests/testthat/_snaps/progress-c.md @@ -23,6 +23,22 @@ [5] "\r5/10\033[K\r" "\r6/10\033[K\r" "\r7/10\033[K\r" "\r8/10\033[K\r" [9] "\r9/10\033[K\r" "\r\033[K" +--- + + Code + .Call(dll$clitest__progress_crud, list(123)) + Condition + Error: + ! Invalid cli progress bar configuration, list elements must be named. + +--- + + Code + .Call(dll$clitest__progress_crud, 100L) + Condition + Error: + ! Unknown cli progress bar configuation, see manual. + --- Code @@ -106,3 +122,19 @@ [9] "\r9/10\033[K\r" "\rJust did 10 steps.\033[K\r" [11] "\n" +# clic__find_var + + Code + .Call(clic__find_var, env, as.symbol("x")) + Condition + Error: + ! Cannot find variable `x`. + +--- + + Code + .Call(clic__find_var, environment(), as.symbol(basename(tempfile()))) + Condition + Error: + ! Cannot find variable ``. + diff --git a/tests/testthat/_snaps/progress-client.md b/tests/testthat/_snaps/progress-client.md index cfa6f802..9402dc64 100644 --- a/tests/testthat/_snaps/progress-client.md +++ b/tests/testthat/_snaps/progress-client.md @@ -5,6 +5,14 @@ Output [1] "\\ name status 1\n" +# custom format needs a format string + + Code + cli_progress_bar(type = "custom") + Condition + Error in `cli_progress_bar()`: + ! Need to specify format if `type == "custom" + # removes previous progress bar Code @@ -13,6 +21,38 @@ [1] "first\n" "first done\n" "\n" "second\n" [5] "second done\n" "\n" +# update errors if no progress bar + + Code + fun() + Condition + Error in `cli_progress_update()`: + ! Cannot find current progress bar for `>` + +--- + + Code + fun() + Condition + Error in `cli_progress_output()`: + ! Cannot find current progress bar for `>` + +--- + + Code + fun() + Condition + Error in `cli_progress_update()`: + ! Cannot find progress bar `foobar` + +--- + + Code + fun() + Condition + Error in `cli_progress_output()`: + ! Cannot find progress bar `foobar` + # cli_progress_update can update status Code diff --git a/tests/testthat/_snaps/progress-message.md b/tests/testthat/_snaps/progress-message.md index 18af2313..c23151ab 100644 --- a/tests/testthat/_snaps/progress-message.md +++ b/tests/testthat/_snaps/progress-message.md @@ -7,12 +7,32 @@ # cli_progress_message error + Code + callr::r(fun, stdout = outfile, stderr = outfile) + Condition + Error: + ! in callr subprocess. + Caused by error: + ! oopsie + +--- + Code readLines(outfile) Output [1] "Simplest progress 'bar', `fn()` 2 twos" [2] "Error in (function () : oopsie" +--- + + Code + callr::r(fun2, stdout = outfile, stderr = outfile) + Condition + Error: + ! in callr subprocess. + Caused by error: + ! oopsie + --- Code @@ -31,6 +51,16 @@ # cli_progress_step error + Code + callr::r(fun, stdout = outfile, stderr = "2>&1") + Condition + Error: + ! in callr subprocess. + Caused by error: + ! oopsie + +--- + Code win2unix(out) Output diff --git a/tests/testthat/_snaps/rules.md b/tests/testthat/_snaps/rules.md index 8fd2c253..55a1bb63 100644 --- a/tests/testthat/_snaps/rules.md +++ b/tests/testthat/_snaps/rules.md @@ -1,3 +1,16 @@ +# centered label + + Code + rule(left = "label", center = "label") + Condition + Error in `rule()`: + ! 'center' cannot be specified with 'left' or 'right' + Code + rule(center = "label", right = "label") + Condition + Error in `rule()`: + ! 'center' cannot be specified with 'left' or 'right' + # print.cli_rule Code diff --git a/tests/testthat/_snaps/substitution.md b/tests/testthat/_snaps/substitution.md new file mode 100644 index 00000000..e01a5cb0 --- /dev/null +++ b/tests/testthat/_snaps/substitution.md @@ -0,0 +1,19 @@ +# glue errors + + Code + cli_h1("foo { asdfasdfasdf } bar") + Condition + Error: + ! Could not evaluate cli `{}` expression: ` asdfasdfasdf `. + Caused by error: + ! object 'asdfasdfasdf' not found + Code + cli_text("foo {cmd {dsfsdf()}}") + Condition + Error: + ! Could not parse cli `{}` expression: `cmd {dsfsdf()}`. + Caused by error: + ! :1:5: unexpected '{' + 1: cmd { + ^ + diff --git a/tests/testthat/_snaps/utils.md b/tests/testthat/_snaps/utils.md index 60abdf23..d90ee81f 100644 --- a/tests/testthat/_snaps/utils.md +++ b/tests/testthat/_snaps/utils.md @@ -1,3 +1,12 @@ +# apply_style + + Code + apply_style("text", raw(0)) + Condition + Error: + ! `style` must be a color name or an ANSI style function + i `style` is + # ruler Code diff --git a/tests/testthat/helper.R b/tests/testthat/helper.R index 35361e40..e8a366e5 100644 --- a/tests/testthat/helper.R +++ b/tests/testthat/helper.R @@ -243,3 +243,7 @@ r_pty <- function(.envir = parent.frame()) { p$read_output() p } + +transform_env <- function(x) { + sub("environment: 0x[0-9a-f]+", "environment: ", x) +} diff --git a/tests/testthat/test-ansi-hyperlink.R b/tests/testthat/test-ansi-hyperlink.R index 219b0b57..d0026c6b 100644 --- a/tests/testthat/test-ansi-hyperlink.R +++ b/tests/testthat/test-ansi-hyperlink.R @@ -390,7 +390,7 @@ test_that("get_config_chr() consults option, env var, then its default", { test_that("get_config_chr() errors if option is not NULL or string", { withr::local_options(cli.something = FALSE) - expect_error(get_config_chr("something"), "is_string") + expect_snapshot(error = TRUE, get_config_chr("something")) }) test_that("get_hyperlink_format() delivers custom format", { diff --git a/tests/testthat/test-assertions.R b/tests/testthat/test-assertions.R index 26f08252..cb49dc36 100644 --- a/tests/testthat/test-assertions.R +++ b/tests/testthat/test-assertions.R @@ -17,11 +17,7 @@ test_that("is_string", { for (n in not_strings) { expect_false(is_string(n)) - expect_error( - stopifnot(is_string(n)), - "is_string(n) is not TRUE", - fixed = TRUE - ) + expect_snapshot(error = TRUE, stopifnot(is_string(n))) } }) @@ -30,11 +26,7 @@ test_that("is_border_style", { expect_false(is_border_style("blahblahxxx")) expect_silent(stopifnot(is_border_style(rownames(box_styles())[1]))) - expect_error( - stopifnot(is_border_style("blahblahxxx")), - "is_border_style(\"blahblahxxx\") is not TRUE", - fixed = TRUE - ) + expect_snapshot(error = TRUE, stopifnot(is_border_style("blahblahxxx"))) }) test_that("is_padding_or_margin", { @@ -60,11 +52,7 @@ test_that("is_padding_or_margin", { } for (b in bad) { expect_false(is_padding_or_margin(b)) - expect_error( - stopifnot(is_padding_or_margin(b)), - "is_padding_or_margin(b) is not TRUE", - fixed = TRUE - ) + expect_snapshot(error = TRUE, stopifnot(is_padding_or_margin(b))) } }) @@ -78,11 +66,7 @@ test_that("is_col", { } for (b in bad) { expect_false(is_col(b)) - expect_error( - stopifnot(is_col(b)), - "is_col(b) is not TRUE", - fixed = TRUE - ) + expect_snapshot(error = TRUE, stopifnot(is_col(b))) } }) @@ -106,11 +90,7 @@ test_that("is_count", { for (n in not_counts) { expect_false(is_count(n)) - expect_error( - stopifnot(is_count(n)), - "is_count(n) is not TRUE", - fixed = TRUE - ) + expect_snapshot(error = TRUE, stopifnot(is_count(n))) } }) diff --git a/tests/testthat/test-diff.R b/tests/testthat/test-diff.R index 4243f9d9..8a68fe4c 100644 --- a/tests/testthat/test-diff.R +++ b/tests/testthat/test-diff.R @@ -48,19 +48,12 @@ test_that_cli(configs = c("plain", "ansi"), "diff_str", { }) test_that("warnings and errors", { - expect_error(diff_chr(1:10, 1:10), "is.character") - expect_error( - format(diff_chr("foo", "bar"), context = -1), - "is_count" - ) - expect_warning( - format(diff_chr("foo", "bar"), what = 1, is = 2, this = 3), - "Extra arguments" - ) - expect_warning( - format(diff_str("foo", "bar"), what = 1, is = 2, this = 3), - "Extra arguments" - ) + expect_snapshot(error = TRUE, { + diff_chr(1:10, 1:10) + format(diff_chr("foo", "bar"), context = -1) + format(diff_chr("foo", "bar"), what = 1, is = 2, this = 3) + format(diff_str("foo", "bar"), what = 1, is = 2, this = 3) + }) }) test_that("max_diff", { diff --git a/tests/testthat/test-pluralization.R b/tests/testthat/test-pluralization.R index 38091fa2..d1b50cda 100644 --- a/tests/testthat/test-pluralization.R +++ b/tests/testthat/test-pluralization.R @@ -78,22 +78,12 @@ test_that("post-processing", { }) test_that("post-processing errors", { - expect_error( - cli_text("package{?s}"), - "Cannot pluralize without a quantity" - ) - expect_error( - pluralize("package{?s}"), - "Cannot pluralize without a quantity" - ) - expect_error( - cli_text("package{?s} {5} {10}"), - "Multiple quantities for pluralization" - ) - expect_error( - pluralize("package{?s} {5} {10}"), - "Multiple quantities for pluralization" - ) + expect_snapshot(error = TRUE, { + cli_text("package{?s}") + pluralize("package{?s}") + cli_text("package{?s} {5} {10}") + pluralize("package{?s} {5} {10}") + }) }) test_that("issue 158", { diff --git a/tests/testthat/test-progress-along.R b/tests/testthat/test-progress-along.R index 1494f84c..ec75bfca 100644 --- a/tests/testthat/test-progress-along.R +++ b/tests/testthat/test-progress-along.R @@ -69,7 +69,7 @@ test_that("cli_progress_along error", { } outfile <- tempfile() - expect_error(callr::r(fun, stdout = outfile, stderr = outfile)) + expect_snapshot(error = TRUE, callr::r(fun, stdout = outfile, stderr = outfile)) lines <- fix_logger_output(readLines(outfile)) expect_snapshot(lines) diff --git a/tests/testthat/test-progress-c.R b/tests/testthat/test-progress-c.R index 886c562e..52da2689 100644 --- a/tests/testthat/test-progress-c.R +++ b/tests/testthat/test-progress-c.R @@ -30,14 +30,12 @@ test_that("c api #1", { expect_snapshot(out) # config must be a named list - expect_error( - .Call(dll$clitest__progress_crud, list(123)), - "list elements must be named" - ) - expect_error( - .Call(dll$clitest__progress_crud, 100L), - "Unknown cli progress bar configuation" - ) + expect_snapshot(error = TRUE, { + .Call(dll$clitest__progress_crud, list(123)) + }) + expect_snapshot(error = TRUE, { + .Call(dll$clitest__progress_crud, 100L) + }) # config can be a progress bar name withr::local_options( @@ -122,14 +120,12 @@ test_that("clic__find_var", { expect_equal(.Call(clic__find_var, environment(), as.symbol("x")), 10) # not inherit env <- new.env(parent = environment()) - expect_error( - .Call(clic__find_var, env, as.symbol("x")), - "Cannot find variable" - ) - expect_error( - .Call(clic__find_var, environment(), as.symbol(basename(tempfile()))), - "Cannot find variable" - ) + expect_snapshot(error = TRUE, { + .Call(clic__find_var, env, as.symbol("x")) + }) + expect_snapshot(error = TRUE, { + .Call(clic__find_var, environment(), as.symbol(basename(tempfile()))) + }, transform = function(x) sub("`file.*`", "``", x)) }) test_that("unloading stops the thread", { diff --git a/tests/testthat/test-progress-client.R b/tests/testthat/test-progress-client.R index 17e52a6e..f14cfaf9 100644 --- a/tests/testthat/test-progress-client.R +++ b/tests/testthat/test-progress-client.R @@ -13,7 +13,9 @@ test_that("cli_progress_bar", { }) test_that("custom format needs a format string", { - expect_error(cli_progress_bar(type = "custom"), "Need to specify format") + expect_snapshot(error = TRUE, { + cli_progress_bar(type = "custom") + }) }) test_that("removes previous progress bar", { @@ -51,12 +53,16 @@ test_that("update errors if no progress bar", { fun <- function() { cli_progress_update() } - expect_error(fun(), "Cannot find current progress bar") + expect_snapshot( + error = TRUE, + fun(), + transform = transform_env + ) fun <- function() { cli_progress_output("boo") } - expect_error(fun(), "Cannot find current progress bar") + expect_snapshot(error = TRUE, fun(), transform = transform_env) envkey <- NULL fun <- function() { @@ -64,7 +70,7 @@ test_that("update errors if no progress bar", { clienv$progress_ids[[envkey]] <- "foobar" cli_progress_update() } - expect_error(fun(), "Cannot find progress bar") + expect_snapshot(error = TRUE, fun()) envkey <- NULL fun <- function() { @@ -72,7 +78,7 @@ test_that("update errors if no progress bar", { clienv$progress_ids[[envkey]] <- "foobar" cli_progress_output("booboo") } - expect_error(fun(), "Cannot find progress bar") + expect_snapshot(error = TRUE, fun()) clienv$progress_ids[[envkey]] <- NULL }) diff --git a/tests/testthat/test-progress-message.R b/tests/testthat/test-progress-message.R index e4bfd1d4..8a8582a6 100644 --- a/tests/testthat/test-progress-message.R +++ b/tests/testthat/test-progress-message.R @@ -20,7 +20,9 @@ test_that("cli_progress_message error", { outfile <- tempfile() on.exit(unlink(outfile), add = TRUE) - expect_error(callr::r(fun, stdout = outfile, stderr = outfile), "oopsie") + expect_snapshot(error = TRUE, { + callr::r(fun, stdout = outfile, stderr = outfile) + }) expect_snapshot(readLines(outfile)) # we need the env var as well, because the on.exit handler of the progress @@ -36,7 +38,9 @@ test_that("cli_progress_message error", { outfile <- tempfile() on.exit(unlink(outfile), add = TRUE) - expect_error(callr::r(fun2, stdout = outfile, stderr = outfile), "oopsie") + expect_snapshot(error = TRUE, { + callr::r(fun2, stdout = outfile, stderr = outfile) + }) out <- rawToChar(readBin(outfile, "raw", 1000)) expect_snapshot(win2unix(out)) }) @@ -73,7 +77,9 @@ test_that("cli_progress_step error", { outfile <- tempfile() on.exit(unlink(outfile), add = TRUE) - expect_error(callr::r(fun, stdout = outfile, stderr = "2>&1"), "oopsie") + expect_snapshot(error = TRUE, { + callr::r(fun, stdout = outfile, stderr = "2>&1") + }) out <- fix_times(rawToChar(readBin(outfile, "raw", 1000))) expect_snapshot(win2unix(out)) }) diff --git a/tests/testthat/test-substitution.R b/tests/testthat/test-substitution.R index b3ec8886..9ab82001 100644 --- a/tests/testthat/test-substitution.R +++ b/tests/testthat/test-substitution.R @@ -2,6 +2,8 @@ start_app() on.exit(stop_app(), add = TRUE) test_that("glue errors", { - expect_error(cli_h1("foo { asdfasdfasdf } bar")) - expect_error(cli_text("foo {cmd {dsfsdf()}}")) + expect_snapshot(error = TRUE, { + cli_h1("foo { asdfasdfasdf } bar") + cli_text("foo {cmd {dsfsdf()}}") + }) }) From 76fbec38fe4297ae36313c210e4c2df4c6c22838 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?G=C3=A1bor=20Cs=C3=A1rdi?= Date: Fri, 25 Apr 2025 18:51:49 +0200 Subject: [PATCH 08/12] usethis::use_mit_license() --- LICENSE | 2 +- LICENSE.md | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/LICENSE b/LICENSE index f71f9392..a78862d3 100644 --- a/LICENSE +++ b/LICENSE @@ -1,2 +1,2 @@ -YEAR: 2023 +YEAR: 2025 COPYRIGHT HOLDER: cli authors diff --git a/LICENSE.md b/LICENSE.md index eb14a08a..7035aa07 100644 --- a/LICENSE.md +++ b/LICENSE.md @@ -1,6 +1,6 @@ # MIT License -Copyright (c) 2023 cli authors +Copyright (c) 2025 cli authors Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal From ecb347a664fd4e55e69b9403684dadd558c21c54 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?G=C3=A1bor=20Cs=C3=A1rdi?= Date: Fri, 25 Apr 2025 18:52:30 +0200 Subject: [PATCH 09/12] usethis::use_tidy_description() --- DESCRIPTION | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index d1bf567a..ce7a003e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -7,7 +7,8 @@ Authors@R: c( person("Kirill", "Müller", role = "ctb"), person("Salim", "Brüggemann", , "salim-b@pm.me", role = "ctb", comment = c(ORCID = "0000-0002-5329-5987")), - person("Posit Software, PBC", role = c("cph", "fnd"), comment = c(ROR = "03wc8by49")) + person("Posit Software, PBC", role = c("cph", "fnd"), + comment = c(ROR = "03wc8by49")) ) Description: A suite of tools to build attractive command line interfaces ('CLIs'), from semantic elements: headings, lists, alerts, paragraphs, @@ -57,6 +58,6 @@ Config/Needs/website: usethis, vctrs Config/testthat/edition: 3 +Config/usethis/last-upkeep: 2025-04-25 Encoding: UTF-8 RoxygenNote: 7.3.2 -Config/usethis/last-upkeep: 2025-04-25 From baeddcc80c3a265e88164815297e58af8baa4c3c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?G=C3=A1bor=20Cs=C3=A1rdi?= Date: Fri, 25 Apr 2025 18:54:03 +0200 Subject: [PATCH 10/12] usethis::use_tidy_github_actions() --- .github/workflows/R-CMD-check.yaml | 4 ---- .github/workflows/pkgdown.yaml | 1 - .github/workflows/test-coverage.yaml | 11 ++++++----- README.Rmd | 2 +- 4 files changed, 7 insertions(+), 11 deletions(-) diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index 6073c01b..69cfc6ad 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -8,7 +8,6 @@ on: push: branches: [main, master] pull_request: - branches: [main, master] name: R-CMD-check.yaml @@ -24,11 +23,8 @@ jobs: fail-fast: false matrix: config: - - {os: macos-latest, r: 'devel'} - {os: macos-latest, r: 'release'} - - {os: windows-latest, r: 'devel'} - - {os: windows-latest, r: 'next'} - {os: windows-latest, r: 'release'} # use 4.0 or 4.1 to check with rtools40's older compiler - {os: windows-latest, r: 'oldrel-4'} diff --git a/.github/workflows/pkgdown.yaml b/.github/workflows/pkgdown.yaml index 6acbd8ba..908a0eba 100644 --- a/.github/workflows/pkgdown.yaml +++ b/.github/workflows/pkgdown.yaml @@ -4,7 +4,6 @@ on: push: branches: [main, master] pull_request: - branches: [main, master] release: types: [published] workflow_dispatch: diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml index 98822609..0ab748d6 100644 --- a/.github/workflows/test-coverage.yaml +++ b/.github/workflows/test-coverage.yaml @@ -4,7 +4,6 @@ on: push: branches: [main, master] pull_request: - branches: [main, master] name: test-coverage.yaml @@ -35,14 +34,16 @@ jobs: clean = FALSE, install_path = file.path(normalizePath(Sys.getenv("RUNNER_TEMP"), winslash = "/"), "package") ) + print(cov) covr::to_cobertura(cov) shell: Rscript {0} - - uses: codecov/codecov-action@v4 + - uses: codecov/codecov-action@v5 with: - fail_ci_if_error: ${{ github.event_name != 'pull_request' && true || false }} - file: ./cobertura.xml - plugin: noop + # Fail if error if not on PR, or if on PR and token is given + fail_ci_if_error: ${{ github.event_name != 'pull_request' || secrets.CODECOV_TOKEN }} + files: ./cobertura.xml + plugins: noop disable_search: true token: ${{ secrets.CODECOV_TOKEN }} diff --git a/README.Rmd b/README.Rmd index ae8a3af9..5d05f86a 100644 --- a/README.Rmd +++ b/README.Rmd @@ -32,7 +32,7 @@ asciicast::init_knitr_engine( [![R-CMD-check](https://github.com/r-lib/cli/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/r-lib/cli/actions/workflows/R-CMD-check.yaml) [![](https://www.r-pkg.org/badges/version/cli)](https://www.r-pkg.org/pkg/cli) [![CRAN RStudio mirror downloads](https://cranlogs.r-pkg.org/badges/cli)](https://www.r-pkg.org/pkg/cli) -[![Codecov test coverage](https://codecov.io/gh/r-lib/cli/branch/main/graph/badge.svg)](https://app.codecov.io/gh/r-lib/cli?branch=main) +[![Codecov test coverage](https://codecov.io/gh/r-lib/cli/graph/badge.svg)](https://app.codecov.io/gh/r-lib/cli) A suite of tools to build attractive command line interfaces From c59aedb6eae941405dd0546e6441587f90d7c1d8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?G=C3=A1bor=20Cs=C3=A1rdi?= Date: Fri, 25 Apr 2025 18:55:49 +0200 Subject: [PATCH 11/12] Rebuild README --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index 811d5b87..2436472f 100644 --- a/README.md +++ b/README.md @@ -12,7 +12,7 @@ cli [![CRAN RStudio mirror downloads](https://cranlogs.r-pkg.org/badges/cli)](https://www.r-pkg.org/pkg/cli) [![Codecov test -coverage](https://codecov.io/gh/r-lib/cli/branch/main/graph/badge.svg)](https://app.codecov.io/gh/r-lib/cli?branch=main) +coverage](https://codecov.io/gh/r-lib/cli/graph/badge.svg)](https://app.codecov.io/gh/r-lib/cli) A suite of tools to build attractive command line interfaces (CLIs), From f71c308914c6a0971fcff862026ec3491b011475 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?G=C3=A1bor=20Cs=C3=A1rdi?= Date: Fri, 25 Apr 2025 22:15:26 +0200 Subject: [PATCH 12/12] Add alt-text to pictures --- vignettes/progress-advanced.Rmd | 32 ++++++++++++++++++++++++++++++-- vignettes/progress.Rmd | 9 +++++++++ vignettes/semantic-cli.Rmd | 14 ++++++++++---- vignettes/usethis-ui.Rmd | 8 +++++--- 4 files changed, 54 insertions(+), 9 deletions(-) diff --git a/vignettes/progress-advanced.Rmd b/vignettes/progress-advanced.Rmd index a0e40110..759cef4c 100644 --- a/vignettes/progress-advanced.Rmd +++ b/vignettes/progress-advanced.Rmd @@ -136,11 +136,15 @@ Typically for loops and mapping functions. It shows a bar by default, if the total number of iterations is known. ```{asciicast} +#| label: iterator +#| fig-alt: "Example of an `iterator` progress bar, from left to right it contains a label (`Data cleaning`), a progress bar, the progress percentage, and the ETA." #| echo: false cli_progress_demo("Data cleaning", total = 100, at = 50, clear = FALSE) ``` ```{asciicast} +#| label: iterator2 +#| fig-alt: "Example of an `iterator` progress var, where the total number of iterations is unknown. From left to right it contains a spinner, the label (`Data cleaning`), how many iterations are done (`50 done`), how many seconds it takes to run an iteration, and the elapsed time." #| echo: false cli_progress_demo("Data cleaning", at = 50, clear = FALSE) ``` @@ -150,6 +154,8 @@ cli_progress_demo("Data cleaning", at = 50, clear = FALSE) For a list of tasks, by default it shows a `current/total` display. ```{asciicast} +#| label: tasks +#| fig-alt: "Example of a `tasks` progress bar, from left to right it contains a spinner, the number of completed tasks per the total number of tasks, the ETA, and the specified label: `Finding data files`." #| echo: false cli_progress_demo( "Finding data files", total = 100, at = 50, @@ -158,6 +164,8 @@ cli_progress_demo( ``` ```{asciicast} +#| label: tasks2 +#| fig-alt: "Example of a `tasks` progress bar where the total number of tasks is unknown. From left to right it contains a spinner, the specified label ('Finding data files`), the number of tasks completed, how long it taks to complete a task, and the elapsed time." #| echo: false cli_progress_demo( "Finding data files", at = 50, @@ -170,6 +178,8 @@ cli_progress_demo( For downloads, progress units are shown as bytes by default here. ```{asciicast} +#| label: download +#| fig-alt: "Example of a `download` progress bar. From left to right it contains a label ('Downloading`), an actual progress bar, the completed and the total download size and the ETA." #| echo: false cli_progress_demo( "Downloading", total = 10280, at = 5120, clear = FALSE, @@ -178,6 +188,8 @@ cli_progress_demo( ``` ```{asciicast} +#| label: download2 +#| fig-alt: "Example of a `download` progress bar, where the total download size is unknown. From left to right it contains the specified label (`Downloading`), a spinner, the number of downloaded bytes, the download rate (`kB/s`), and the elapsed time." #| echo: false cli_progress_demo( "Downloading", at = 5120, clear = FALSE, @@ -198,6 +210,8 @@ templating, cli pluralization and cli theming. They can also use a number of built-in cli progress variables, see 'Progress variables' below. ```{asciicast} +#| label: custom +#| fig-alt: "Example of a `custom` progress bar. It contains a dynamic label, `Step 1` that changed to `Step 2` later, a bar and the percentage." #| asciicast_at: "all" f <- function() { cli_progress_bar( @@ -245,6 +259,7 @@ Otherwise `cli.progress_bar_style` is used. On non UTF-8 displays These options can be set to a built-in progress bar style name: ```{r} +#| label: library-cli #| include: false library(cli) ``` @@ -254,6 +269,8 @@ names(cli_progress_styles()) ``` ```{asciicast} +#| label: progress-styles +#| fig-alt: "Example with the `fillsquares` progress bar style. It contains a progress bar where empty squares are filled up, the progress percentage and the ETA." #| asciicast_at: "all" options(cli.progress_bar_style = "fillsquares") f <- function() lapply(cli_progress_along(letters), function(l) Sys.sleep(0.2)) @@ -261,6 +278,7 @@ x <- f() ``` ```{asciicast} +#| label: style-null #| include: false #| cache: false options(cli.progress_bar_style = NULL) @@ -271,6 +289,8 @@ Alternatively, they can be set to a list with entries `complete`, parts of the progress bar: ```{asciicast} +#| label: progress-custom-style +#| fig-alt: "Example of a customized progress bar. Centered black dots are replaced by yellow stars in the progress bar, that also has the progress percentage and the ETA." #| asciicast_at: "all" options(cli.progress_bar_style = list( complete = cli::col_yellow("\u2605"), @@ -281,6 +301,7 @@ x <- f() ``` ```{asciicast} +#| label: style-null2 #| include: false #| asciicast_at: "all" options(cli.progress_bar_style = NULL) @@ -303,6 +324,7 @@ a peek at them. ```{asciicast} #| label: custom-spinner +#| fig-alt: "A custom spinner that shows 20 spinners, each animating the moon phases." #| asciicast_at: "all" options(cli.spinner = "moon") f <- function() { @@ -344,7 +366,7 @@ qualified form, in case the cli package is not attached. For example, to set a minimal display for downloads you might write ```{asciicast} -#| label: download +#| label: download-vars #| include: false #| cache: false #| asciicast_at: "end" @@ -358,7 +380,7 @@ options(cli.progress_format_download = ```{asciicast} #| eval: false -#| label: download2 +#| label: download2-vars #| include: false #| cache: false #| asciicast_at: "end" @@ -373,6 +395,8 @@ options(cli.progress_format_download = to get ```{asciicast} +#| label: download2-vars2 +#| fig-alt: "A custom download progress bar, it has a thick down arrow, a spinner, a label (`Downloading`), the completed and the total number of bytes." #| echo: false cli_progress_demo( "Downloading", total = 10280, at = 5121, clear = FALSE, @@ -386,6 +410,7 @@ use `letters[pb_current]`: ```{asciicast} #| label: function-of-token +#| fig-alt: "A custom progress bar, it has two spinners, one on the left, the other on the right. In the middle it has a dynamic label that iterates over the letters of the English alphabet." #| asciicast_at: "all" f <- function() { cli_progress_bar( @@ -449,6 +474,8 @@ SEXP progress_test1() { ``` ```{asciicast} +#| label: progress-test-1 +#| fig-alt: "A progress bar that also show the progress percentage and the ETA." #| echo: false #| asciicast_at: "all" invisible(progress_test1()) @@ -457,6 +484,7 @@ invisible(progress_test1()) ## C API reference ```{r} +#| label: c-api-reference #| include: false #| cache: false #| child: !expr cli:::docs_progress_c_api() diff --git a/vignettes/progress.Rmd b/vignettes/progress.Rmd index 66a5ce90..244c99d6 100644 --- a/vignettes/progress.Rmd +++ b/vignettes/progress.Rmd @@ -87,6 +87,7 @@ For example: ```{asciicast} #| label: classic-example +#| fig-alt: "Progress bar, that contains, from left to right, the specified label, the bar with green squares, the progress percentage, and the ETA." clean <- function() { cli_progress_bar("Cleaning data", total = 100) for (i in 1:100) { @@ -113,6 +114,7 @@ The current progress bar lets us omit the `cli_progress_done()` call: ```{asciicast} #| label: current +#| fig-alt: "Two progress bars, after the first finishes, the second starts and then finishes as well." clean <- function() { cli_progress_bar("Cleaning data #1", total = 100) for (i in 1:100) { @@ -144,6 +146,7 @@ set.seed(1) ```{asciicast} #| label: unknown-total +#| fig-alt: "Example progress bar where the total number of units is unknown. It has a spinner, the specified label, shows how many units are done, how many units are completed per second and the elapsed time." walk_dirs <- function() { cli_progress_bar("Walking directories") while (TRUE) { @@ -188,6 +191,7 @@ An example: ```{asciicast} #| label: tickalong +#| fig-alt: "Progress bar with green squares, that also shows the progress percentage and the ETA." f <- function() { rawabc <- lapply( cli_progress_along(letters), @@ -251,6 +255,7 @@ default: ```{asciicast} #| label: cli_progress_message +#| fig-alt: "The three messages are shown, each on its own line, the third one is iterated over 5 steps." f <- function() { cli_progress_message("Task one is running...") Sys.sleep(2) @@ -280,6 +285,7 @@ as usual. You can call `cli_progress_update()` to update a status message. ```{asciicast} #| label: cli_progress_step_simple +#| fig-alt: "Four progress steps are shown, each on its own line. Each steps show up as an 'i' (info) step first, and stays like that while it is running. When it is done, the 'i' is turned into a tick mark, and the running time of the step is added to the line at the end, in grey." f <- function() { cli_progress_step("Downloading data") Sys.sleep(2) @@ -301,6 +307,7 @@ message. ```{asciicast} #| label: cli_progress_step +#| fig-alt: "First the 'About to start..'. message is shown in its own line. Then a progress bar starts on the next line. The progress bar takes 10 steps. After the fifth step, the progress bar is overwritten with the 'Already half way!' message and the progress bar is moved down to the third line." f <- function(n = 10) { cli_alert_info("About to start downloads of {n} file{?s}") i <- 0 @@ -319,6 +326,7 @@ add a spinner to it: ```{asciicast} #| label: cli_progress_step_spinner +#| fig-alt: "Four steps are shown, each on its own line. While each step is running, its line has a spinner. Once it is done, the spinner turns into a tick mark and the running time of the step is added to its line at the end." f <- function() { cli_progress_step("Downloading data", spinner = TRUE) for (i in 1:100) { cli_progress_update(); Sys.sleep(2/100) } @@ -337,6 +345,7 @@ status message accordingly: ```{asciicast} #| label: step-error +#| fig-alt: "Two steps are shown, each in its own line. While a step is running its line is an 'i' (info) line. The first step finishes successfully and its 'i' mark is turned into a tick mark. The second step fails with an error and its line is overwritten with the error message, and moved down to the third line, and marked with an 'x' (error) mark." #| asciicast_rows: 3 f <- function() { cli_progress_step("First step, this will succeed") diff --git a/vignettes/semantic-cli.Rmd b/vignettes/semantic-cli.Rmd index 67a1d425..b47d825d 100644 --- a/vignettes/semantic-cli.Rmd +++ b/vignettes/semantic-cli.Rmd @@ -339,8 +339,10 @@ This output is created "above" the status bar, which is always kept in the last See the following example: ```{asciicast} -#| asciicast_at = "all", -#| asciicast_end_wait = 30 +#| label: status-bar +#| asciicast_at: "all" +#| asciicast_end_wait: 30 +#| fig-alt: "First the info message is shown. Then a dynamic status line is shown that shows the number of downloaded and the number of downloading files. After 5 files, this is replaced by the 'Already half-way!' message and the status line is moved down. At the end the status line is overwritten by the 'Downloads done.' message." f <- function() { cli_alert_info("About to start downloads.") sb <- cli_status("{symbol$arrow_right} Downloading 10 files.") @@ -605,11 +607,15 @@ get_spinner("dots") ``` ```{asciicast} -#| asciicast_at = "all" +#| label: spinner-dots +#| fig-alt: "Animation of a spinner made out of Braille characters." +#| asciicast_at: "all" ansi_with_hidden_cursor(demo_spinners("dots")) ``` ```{asciicast} -#| asciicast_at = "all" +#| label: spinner-clock +#| fig-alt: "Animation of a spinner that is a Unicode clock glyph where the small arm of the clock is spinning around." +#| asciicast_at: "all" ansi_with_hidden_cursor(demo_spinners("clock")) ``` diff --git a/vignettes/usethis-ui.Rmd b/vignettes/usethis-ui.Rmd index fec63fcc..eb66dfa3 100644 --- a/vignettes/usethis-ui.Rmd +++ b/vignettes/usethis-ui.Rmd @@ -125,9 +125,11 @@ If you want to handle success and failure, then maybe the `cli_process_*()` functions are a better fit: ```{asciicast} -#| asciicast_at = "all", -#| asciicast_end_wait = 5, -#| asciicast_cursor = FALSE +#| label: process +#| asciicast_at: "all" +#| asciicast_end_wait: 5 +#| asciicast_cursor: FALSE +#| fig-alt: "First shows the task ('Setting...') in an 'i' (info) line. Then, when the task is done, the 'i' is replaced with a tick mark and 'done' added to the end of the line." tryCatch({ cli_process_start("Setting {.field {name}} field in DESCRIPTION to {.val {value}}") Sys.sleep(1) # <- do the task here, we just sleep