diff --git a/.Rbuildignore b/.Rbuildignore index f15ab3f96..df53f5156 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/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index 6073c01b2..69cfc6adf 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 6acbd8ba1..908a0ebae 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 988226098..0ab748d65 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/.vscode/extensions.json b/.vscode/extensions.json new file mode 100644 index 000000000..344f76eba --- /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 000000000..f2d0b79d6 --- /dev/null +++ b/.vscode/settings.json @@ -0,0 +1,6 @@ +{ + "[r]": { + "editor.formatOnSave": true, + "editor.defaultFormatter": "Posit.air-vscode" + } +} diff --git a/DESCRIPTION b/DESCRIPTION index 3119d2530..ce7a003e6 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")) + 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,5 +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 diff --git a/LICENSE b/LICENSE index f71f9392e..a78862d32 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 eb14a08a0..7035aa077 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 diff --git a/R/aaa-utils.R b/R/aaa-utils.R index e41e7587b..080e67f78 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 a295c846b..6bbd0c5ea 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 a059f8c44..c138c50e4 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 04209eb31..0511e27c2 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 113f237f4..95bc45e0f 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 1c828df5b..407f23fc1 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 1c6dae20f..422a5d8a6 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 a25dc4948..7f0bc4782 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 0e4209a32..f161c8b56 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 ae7997fa9..d99da431a 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 95da8bf1c..c71c5d52a 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 100db4f58..008d10713 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 5d8e05c09..aa38c187c 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 4843e9c00..ffdb7fdd8 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 bffc22666..b95ad5fe4 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 1101344df..51903edd7 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 5db0b0a05..79bf13f1c 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 e6fac5805..d719f4401 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 6943ca97b..ca903fbb4 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 ff42606a2..280ebf48c 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 7a74cfa31..d6165ca7f 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 f9bca1d7c..6b9784908 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 508637df4..7ab6a9607 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 c387db412..f7051a363 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 772f40d51..1cebaddb2 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 10d377bf5..ccc2c35a5 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 2333e11ce..9f16d2ee8 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 b8f08572b..94d3b5799 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 214277023..64c804b4b 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 2a28eb2d3..9b643eca5 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 2436645ce..d4bf3a3da 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 bc0a4e2b0..f585b19d0 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 2cad07fa2..93c8a47f7 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 716eb04e1..acebc8ef1 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 67d020fd5..e6a11909f 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 b0279943f..2380a9ca0 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 68b82f08c..c7663fc61 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 8e3062091..a61355b37 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 cefedb893..8c8dca2dd 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 ec4d6b653..caf9bbcf3 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 fdad17af7..b7cbefe30 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 09b42dcf5..16d2909fd 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 6e654139b..660f39431 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 2f2d8f509..4d731afaf 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 2c55572f5..882879faf 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 478040e7c..330cdc46f 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 a81557709..e31d210c4 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 4e280151c..c9129f4da 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 ce6e79e5b..41447e068 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 0e37cb461..e19537d93 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 1a665e371..2654bd9fb 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 4409ef896..5b784780d 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 9928e2091..d6f27d4ba 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. @@ -49,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) @@ -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 f092d6929..86556b7ef 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 1dacbc1f9..9720c1160 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 830203cc8..bd37c8fc3 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 0ea177964..edbad74bd 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 91701a405..df1aa0f24 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 a05b5e5b9..b4236d2d8 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 3f34c9015..7cd2faf2e 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 826702ab0..0c913d7f4 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) } @@ -73,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)))') #' ``` #' @@ -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 13bdf5c85..380b8bfdb 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 231edc4e7..d56454e60 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 0fef223c8..38d0320a7 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 e32e8454c..73730ec9f 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 f0863734e..214a96645 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 722cb79bb..d792c0357 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 9a3cce73d..e8b2ac688 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 f923ec8a7..c83ff4614 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 2ebaedfbb..0872061a9 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 98b511056..70f4f3034 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 c4b4a7ffd..299a9cd5c 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/README.Rmd b/README.Rmd index ae8a3af92..5d05f86af 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 diff --git a/README.md b/README.md index 811d5b871..2436472f4 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), diff --git a/air.toml b/air.toml new file mode 100644 index 000000000..e69de29bb diff --git a/exec/news.R b/exec/news.R index 99c155734..4a9c58a69 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 388726773..51f5bbf11 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 f635b938c..c1a36ba53 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 3f8f33367..cc44c79c0 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 99c155734..4a9c58a69 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 542c5c67e..f2aa4f1ca 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 51e6501ac..5fd31a2e6 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 b87ac4987..946e06aa1 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 7300de1d0..735a68b59 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 f134c97a8..068f22db5 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 db8395667..d93ade7a2 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 c87e431e5..e09cf468c 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/builtin_theme.Rd b/man/builtin_theme.Rd index fdd94853c..788e971f6 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/roxygen/meta.R b/man/roxygen/meta.R index fd94ea9fc..6b8887313 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/man/simple_theme.Rd b/man/simple_theme.Rd index bf462f705..dc93507d3 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))) #> diff --git a/tests/testthat/_snaps/ansi-hyperlink.md b/tests/testthat/_snaps/ansi-hyperlink.md index b00c2e6ef..a6bcf40ed 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 000000000..ddda04fcf --- /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 63d5573c6..d401a8dec 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 e6d3d91eb..3ffb2eb09 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 ea44f3ac4..f8c362a12 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 2d430533a..d26fecf6a 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 cfa6f8023..9402dc64f 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 18af23138..c23151ab6 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 8fd2c253f..55a1bb637 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 000000000..e01a5cb0e --- /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 60abdf236..d90ee81fd 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 77f879974..e8a366e59 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,13 +230,20 @@ 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() p } + +transform_env <- function(x) { + sub("environment: 0x[0-9a-f]+", "environment: ", x) +} diff --git a/tests/testthat/progresstest/R/test.R b/tests/testthat/progresstest/R/test.R index 8d2b8a855..8ae5f0df4 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 b05d5f401..862258fc1 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 81f618508..36f1abbcb 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 5c02a8e72..76d963039 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 f6a254265..1a8f8915c 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 4ea63cdb1..f9dc8fe85 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 a9e688126..d0026c6b2 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()) ) @@ -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", { @@ -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 3f0c02d05..a46969772 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 0cf256fe3..415be07e7 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 69bd137b3..aaa13ccd8 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 943a6e0a7..663dde626 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 ce90d35c0..a57e0ef89 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 842942e85..c87672dbf 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 37da34e03..dfcdace24 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 e9ed5dfe0..cb49dc36d 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)) @@ -12,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))) } }) @@ -25,18 +26,25 @@ 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", { - 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)) @@ -44,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))) } }) @@ -62,19 +66,22 @@ 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))) } }) 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)) @@ -83,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))) } }) @@ -108,6 +111,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 e3c55b503..e8cfdc3d9 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 ecd23b294..7d3034eb1 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 6d95ee2f0..dfc291992 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 072a425d5..7ea8d2367 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 8d5309746..c8550fe77 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 a296e0ea5..f9dd44aea 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 45a3fe952..b7336f152 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 156412e79..0ae11c2b8 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 aea6231a8..963754ef9 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 140f4f4fb..92c11ad3e 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 b5a706bb9..4a44afe28 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 2e7f910f1..f80a97ecc 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 a5bb9d09a..1baa6f718 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 b47a7955f..9af324dc2 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 482973a00..8a68fe4cb 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)) @@ -49,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-format-conditions.R b/tests/testthat/test-format-conditions.R index 9056d5548..5da48efff 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 1ffaa0adb..dc624be2b 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 d9b5a6ba4..92d90cf73 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 52138ec2a..98bcef2bd 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 00c642d4a..e4c2bf443 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 95d6d9c55..576929726 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 d55dd0da1..875f05561 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 aec64cace..60f16f8de 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 19c3fcfe2..0079a91b6 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 55398628b..26efbb265 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 f81589afd..cf1dae735 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 29a5b3f17..8dcc85454 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 004b83815..f05c05a46 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 994e85859..d1b50cdaa 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}")) }) }) @@ -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-prettycode.R b/tests/testthat/test-prettycode.R index 5f5cbfb01..71aa27848 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 4390b1368..ec75bfcaf 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,12 +62,14 @@ 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") + } ) } 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-bar.R b/tests/testthat/test-progress-bar.R index 3fd29965d..e4b8075bf 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 b5afee254..52da26891 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) @@ -31,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( @@ -123,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 210d5b746..f14cfaf91 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() { @@ -14,15 +13,25 @@ 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", { 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) } @@ -44,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() { @@ -57,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() { @@ -65,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 }) @@ -133,11 +146,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 +200,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 997df7188..74f378df9 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 c2b708951..2b0e395ab 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 db88eeab0..1f0944947 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 5e177cd28..8a8582a6c 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() { @@ -21,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 @@ -37,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)) }) @@ -74,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-progress-ticking.R b/tests/testthat/test-progress-ticking.R index 250ad9b92..fb3710c38 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 2df654815..964e9728e 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 b49416b8c..e29aa8af7 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 61bb0b6bb..def768bfc 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 db37c54fe..7f0e9f9ec 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 4e50e270c..763f42672 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,15 +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 = "-"), @@ -109,9 +101,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 01b9b8074..f338fa045 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 c91c92852..ad96aa309 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 0e0ea0ed0..78a14ea5c 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 3a8b86786..c38a429fb 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 cc9a06efd..90b372686 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 d080660b2..9ab820014 100644 --- a/tests/testthat/test-substitution.R +++ b/tests/testthat/test-substitution.R @@ -1,8 +1,9 @@ - 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()}}") + }) }) diff --git a/tests/testthat/test-suppress.R b/tests/testthat/test-suppress.R index 6ef005d6b..40e1cc299 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 630f735db..b237aad7a 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 50b7e835d..999f0fa2f 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 b6ed77f90..02b965c78 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 64aeac192..d2c70fa40 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 29921465e..f9a2963ed 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 f50940ece..30ab09d76 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 103688737..42049e23e 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") }) @@ -10,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" @@ -57,7 +53,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 +71,6 @@ test_that("is_utf8_output", { }) test_that("is_latex_output", { - local_mocked_bindings(loadedNamespaces = function() "foobar") expect_false(is_latex_output()) @@ -170,15 +164,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 ea4fc3b2a..083fb3698 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 4d51d00f9..938cbebcb 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 d87541d8c..63b17a307 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 05d14a9b7..5ef503be9 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 889fc6fd7..61be96a4c 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) + ) ) diff --git a/vignettes/ansi-benchmark.Rmd b/vignettes/ansi-benchmark.Rmd index 2eadd56e1..7d1750dd9 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 840fdcce3..dd595bfa4 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 e5bbc0a2d..aba4b8ebd 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 ed2d425aa..759cef4c8 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,17 @@ 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} +#| 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 echo = 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) ``` @@ -142,14 +153,20 @@ 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} +#| 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, clear = FALSE, type = "tasks" ) ``` -```{asciicast echo = FALSE} +```{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, clear = FALSE, type = "tasks" @@ -160,14 +177,20 @@ cli_progress_demo( For downloads, progress units are shown as bytes by default here. -```{asciicast echo = FALSE} +```{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, type = "download" ) ``` -```{asciicast echo = FALSE} +```{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, type = "download" @@ -187,7 +210,9 @@ 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" +#| 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( total = 20000, @@ -233,7 +258,9 @@ 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} +#| label: library-cli +#| include: false library(cli) ``` @@ -242,13 +269,18 @@ names(cli_progress_styles()) ``` ```{asciicast} -#| asciicast_at = "all" +#| 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)) x <- f() ``` -```{asciicast include = FALSE, cache = FALSE} +```{asciicast} +#| label: style-null +#| include: false +#| cache: false options(cli.progress_bar_style = NULL) ``` @@ -257,7 +289,9 @@ Alternatively, they can be set to a list with entries `complete`, parts of the progress bar: ```{asciicast} -#| asciicast_at = "all" +#| 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"), incomplete = cli::col_grey("\u00b7") @@ -266,8 +300,10 @@ f <- function() lapply(cli_progress_along(letters), function(l) Sys.sleep(0.2)) x <- f() ``` -```{asciicast include = FALSE} -#| asciicast_at = "all" +```{asciicast} +#| label: style-null2 +#| include: false +#| asciicast_at: "all" options(cli.progress_bar_style = NULL) ``` @@ -286,8 +322,10 @@ 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 +#| fig-alt: "A custom spinner that shows 20 spinners, each animating the moon phases." +#| asciicast_at: "all" options(cli.spinner = "moon") f <- function() { cli_progress_bar(format = strrep("{cli::pb_spin} ", 20), clear = TRUE) @@ -327,8 +365,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-vars +#| include: false +#| cache: false +#| asciicast_at: "end" options(cli.progress_format_download = paste0( "{cli::col_cyan('\u2B07')} {cli::pb_spin} ", @@ -337,13 +378,26 @@ options(cli.progress_format_download = ) ``` -```{asciicast eval = FALSE} -<> +```{asciicast} +#| eval: false +#| label: download2-vars +#| 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} +#| 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, type = "download" @@ -354,8 +408,10 @@ 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 +#| 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( total = 26, @@ -401,7 +457,8 @@ traditional R API: A complete example: -```{asciicastcpp11 capi} +```{asciicastcpp11} +#| label: capi #include SEXP progress_test1() { int i; @@ -416,12 +473,19 @@ SEXP progress_test1() { } ``` -```{asciicast, echo = FALSE, dependson = -1} -#| asciicast_at = "all" +```{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()) ``` ## C API reference -```{r include = FALSE, cache = FALSE, child = cli:::docs_progress_c_api()} +```{r} +#| label: c-api-reference +#| include: false +#| cache: false +#| child: !expr cli:::docs_progress_c_api() ``` diff --git a/vignettes/progress-benchmark.Rmd b/vignettes/progress-benchmark.Rmd index 213194987..3c8affba9 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 7b4b00ec1..244c99d68 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,9 @@ Add a progress bar in three steps: For example: -```{asciicast classic-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) { @@ -101,7 +112,9 @@ or is interrupted. The current progress bar lets us omit the `cli_progress_done()` call: -```{asciicast current} +```{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) { @@ -124,11 +137,16 @@ 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 +#| 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) { @@ -171,7 +189,9 @@ from beginning to end. It is best to never assign the return value of An example: -```{asciicast, tickalong} +```{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), @@ -233,7 +253,9 @@ 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 +#| 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) @@ -261,7 +283,9 @@ 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 +#| 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) @@ -281,7 +305,9 @@ f() As usual, you can use `cli_progress_step()` to update an existing status message. -```{asciicast cli_progress_step} +```{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 @@ -298,7 +324,9 @@ 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 +#| 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) } @@ -315,8 +343,10 @@ f() `cli_progress_step()` automatically handles errors, and styles the status message accordingly: -```{asciicast step-error} -#| asciicast_rows = 3 +```{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") Sys.sleep(1) diff --git a/vignettes/semantic-cli.Rmd b/vignettes/semantic-cli.Rmd index 20d21abf6..b47d825d8 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) ``` @@ -336,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.") @@ -602,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 97aca7dcc..eb66dfa31 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)}") ``` @@ -121,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