diff --git a/R/author.R b/R/author.R index 7e396e4ac..0199f4e7d 100644 --- a/R/author.R +++ b/R/author.R @@ -80,7 +80,7 @@ use_author <- function(given = NULL, family = NULL, ..., role = "ctb") { } -challenge_legacy_author_fields <- function(d = proj_desc()) { +challenge_legacy_author_fields <- function(d = proj_desc(), .envir = parent.frame()) { has_legacy_field <- d$has_fields("Author") || d$has_fields("Maintainer") if (!has_legacy_field) { return(invisible()) @@ -95,13 +95,13 @@ challenge_legacy_author_fields <- function(d = proj_desc()) { "_" = "Convert to {.field Authors@R} with {.fun desc::desc_coerce_authors_at_r}, then delete the legacy fields." )) - if (ui_yep("Do you want to cancel this operation and sort that out first?")) { + if (ui_yep("Do you want to cancel this operation and sort that out first?", .envir = .envir)) { ui_abort("Cancelling.") } invisible() } -check_author_is_novel <- function(given = NULL, family = NULL, d = proj_desc()) { +check_author_is_novel <- function(given = NULL, family = NULL, d = proj_desc(), call = caller_env()) { authors <- d$get_authors() authors_given <- purrr::map(authors, "given") authors_family <- purrr::map(authors, "family") @@ -114,7 +114,9 @@ check_author_is_novel <- function(given = NULL, family = NULL, d = proj_desc()) "x" = "{.val {aut_name}} already appears in {.field Authors@R}.", " " = "Please make the desired change directly in DESCRIPTION or call the {.pkg desc} package directly." - )) + ), + call = call + ) } invisible() } diff --git a/R/block.R b/R/block.R index 01d768a35..a6bafa115 100644 --- a/R/block.R +++ b/R/block.R @@ -87,7 +87,7 @@ block_show <- function(path, block_start = "# <<<", block_end = "# >>>") { lines[seq2(block[[1]], block[[2]])] } -block_find <- function(lines, block_start = "# <<<", block_end = "# >>>") { +block_find <- function(lines, block_start = "# <<<", block_end = "# >>>", call = caller_env()) { # No file if (is.null(lines)) { return(NULL) @@ -106,7 +106,9 @@ block_find <- function(lines, block_start = "# <<<", block_end = "# >>>") { "Invalid block specification.", "Must start with {.code {block_start}} and end with {.code {block_end}}." - )) + ), + call = call + ) } c(start + 1L, end - 1L) diff --git a/R/git.R b/R/git.R index 6596a6449..40523a1aa 100644 --- a/R/git.R +++ b/R/git.R @@ -252,7 +252,9 @@ use_git_remote <- function(name = "origin", url, overwrite = FALSE) { ui_abort(c( "Remote {.val {name}} already exists.", "Use {.code overwrite = TRUE} to edit it anyway." - )) + ), + call = parent.frame() + ) } if (name %in% names(remotes)) { diff --git a/R/github.R b/R/github.R index f1f2a615c..5d8b5ec8f 100644 --- a/R/github.R +++ b/R/github.R @@ -91,7 +91,9 @@ use_github <- function(organisation = NULL, if (visibility_specified) { ui_abort(" The {.arg visibility} setting is only relevant for organisation-owned - repos, within the context of certain GitHub Enterprise products.") + repos, within the context of certain GitHub Enterprise products.", + call = parent.frame() + ) } visibility <- if (private) "private" else "public" } @@ -106,7 +108,9 @@ use_github <- function(organisation = NULL, "x" = "Unable to discover a GitHub personal access token.", "i" = "A token is required in order to create and push to a new repo.", "_" = "Call {.run usethis::gh_token_help()} for help configuring a token." - )) + ), + call = parent.frame() + ) } empirical_host <- parse_github_remotes(glue("{whoami$html_url}/REPO"))$host if (empirical_host != "github.com") { @@ -255,7 +259,7 @@ has_github_links <- function() { has_github_url && has_github_issues } -check_no_origin <- function() { +check_no_origin <- function(call = caller_env()) { remotes <- git_remotes() if ("origin" %in% names(remotes)) { ui_abort(c( @@ -263,12 +267,14 @@ check_no_origin <- function() { {.val {remotes[['origin']]}}.", "i" = "You can remove this setting with:", " " = '{.code usethis::use_git_remote("origin", url = NULL, overwrite = TRUE)}' - )) + ), + call = call + ) } invisible() } -check_no_github_repo <- function(owner, repo, host) { +check_no_github_repo <- function(owner, repo, host, call = caller_env()) { repo_found <- tryCatch( { repo_info <- gh::gh( @@ -285,5 +291,8 @@ check_no_github_repo <- function(owner, repo, host) { } spec <- glue("{owner}/{repo}") empirical_host <- parse_github_remotes(repo_info$html_url)$host - ui_abort("Repo {.val {spec}} already exists on {.val {empirical_host}}.") + ui_abort( + "Repo {.val {spec}} already exists on {.val {empirical_host}}.", + call = call + ) } diff --git a/R/pr.R b/R/pr.R index 8e2e2933b..445afdd0b 100644 --- a/R/pr.R +++ b/R/pr.R @@ -628,7 +628,7 @@ pr_clean <- function(number = NULL, # we're in DEFAULT branch of a fork. I wish everyone set up DEFAULT to track the # DEFAULT branch in the source repo, but this protects us against sub-optimal # setup. -pr_pull_source_override <- function(tr = NULL, default_branch = NULL) { +pr_pull_source_override <- function(tr = NULL, default_branch = NULL, call = caller_env()) { # naive selection of target repo; calling function should analyse the config tr <- tr %||% target_repo(github_get = FALSE, ask = FALSE) @@ -639,7 +639,7 @@ pr_pull_source_override <- function(tr = NULL, default_branch = NULL) { if (current_branch != default_branch) { ui_abort(" Internal error: {.fun pr_pull_source_override} should only be used when on - default branch.") + default branch.", call = call) } # guard against mis-configured forks, that have default branch tracking diff --git a/R/proj.R b/R/proj.R index ce646d317..b2dfbc0ff 100644 --- a/R/proj.R +++ b/R/proj.R @@ -207,7 +207,7 @@ is_package <- function(base_path = proj_get()) { !is.null(res) } -check_is_package <- function(whos_asking = NULL) { +check_is_package <- function(whos_asking = NULL, call = caller_env()) { if (is_package()) { return(invisible()) } @@ -220,15 +220,17 @@ check_is_package <- function(whos_asking = NULL) { "x" = message ) } - ui_abort(message) + ui_abort(message, call = call) } -check_is_project <- function() { +check_is_project <- function(call = caller_env()) { if (!possibly_in_proj()) { ui_abort(c( "We do not appear to be inside a valid project or package.", "Read more in the help for {.fun usethis::proj_get}." - )) + ), + call = caller_env() + ) } } diff --git a/R/utils-git.R b/R/utils-git.R index c1716ffdc..5dff0ed4d 100644 --- a/R/utils-git.R +++ b/R/utils-git.R @@ -27,7 +27,7 @@ uses_git <- function() { !is.null(repo) } -check_uses_git <- function() { +check_uses_git <- function(call = caller_env()) { if (uses_git()) { return(invisible()) } @@ -35,7 +35,7 @@ check_uses_git <- function() { ui_abort(c( "Cannot detect that project is already a Git repository.", "Do you need to run {.run usethis::use_git()}?" - )) + ), call = call) } git_init <- function() { diff --git a/R/utils-github.R b/R/utils-github.R index 4630448e5..4399eea91 100644 --- a/R/utils-github.R +++ b/R/utils-github.R @@ -68,7 +68,7 @@ parse_github_remotes <- function(x) { dat[c("name", "url", "host", "repo_owner", "repo_name", "protocol")] } -parse_repo_url <- function(x) { +parse_repo_url <- function(x, call = caller_env()) { check_name(x) dat <- re_match(x, github_remote_regex) if (is.na(dat$.match)) { @@ -77,7 +77,10 @@ parse_repo_url <- function(x) { dat <- parse_github_remotes(x) # TODO: generalize here for GHE hosts that don't include 'github' if (!grepl("github", dat$host)) { - ui_abort("URL doesn't seem to be associated with GitHub: {.val {x}}") + ui_abort( + "URL doesn't seem to be associated with GitHub: {.val {x}}", + call = call + ) } list( repo_spec = make_spec(owner = dat$repo_owner, repo = dat$repo_name), @@ -162,7 +165,8 @@ github_remote_list <- function(these = c("origin", "upstream"), x = NULL) { #' @noRd github_remotes <- function(these = c("origin", "upstream"), github_get = NA, - x = NULL) { + x = NULL, + call = caller_env()) { grl <- github_remote_list(these = these, x = x) get_gh_repo <- function(repo_owner, repo_name, api_url = "https://api.github.com") { @@ -194,7 +198,9 @@ github_remotes <- function(these = c("origin", "upstream"), "Otherwise, you probably need to configure a personal access token (PAT) for {.val {oops_hosts}}.", "See {.run usethis::gh_token_help()} for advice." - )) + ), + call = call + ) } grl$default_branch <- map_chr(repo_info, "default_branch", .default = NA) @@ -331,17 +337,19 @@ github_remote_config <- function(github_get = NA) { ui_abort(c( "Internal error: Multiple GitHub hosts.", "{.val {grl$host}}" - )) + ), call = parent.frame()) } if (length(unique(grl$github_got)) != 1) { ui_abort(c( "Internal error: Got GitHub API info for some remotes, but not all.", "Do all the remotes still exist? Do you still have access?" - )) + ), call = parent.frame()) } if (length(unique(grl$perm_known)) != 1) { - ui_abort(" - Internal error: Know GitHub permissions for some remotes, but not all.") + ui_abort( + "Internal error: Know GitHub permissions for some remotes, but not all.", + call = parent.frame() + ) } } cfg$host_url <- unique(grl$host_url) @@ -468,15 +476,16 @@ target_repo <- function(cfg = NULL, github_get = NA, role = c("source", "primary"), ask = is_interactive(), - ok_configs = c("ours", "fork", "theirs")) { + ok_configs = c("ours", "fork", "theirs"), + call = caller_env()) { cfg <- cfg %||% github_remote_config(github_get = github_get) stopifnot(inherits(cfg, "github_remote_config")) role <- match.arg(role) - check_for_bad_config(cfg) + check_for_bad_config(cfg, call = call) if (isTRUE(github_get)) { - check_for_config(cfg, ok_configs = ok_configs) + check_for_config(cfg, ok_configs = ok_configs, call = call) } # upstream only @@ -508,8 +517,9 @@ target_repo <- function(cfg = NULL, } target_repo_spec <- function(role = c("source", "primary"), - ask = is_interactive()) { - tr <- target_repo(role = match.arg(role), ask = ask) + ask = is_interactive(), + call = caller_env()) { + tr <- target_repo(role = match.arg(role), ask = ask, call = call) tr$repo_spec } @@ -600,15 +610,16 @@ ui_github_remote_config_wat <- function(cfg) { ) } -stop_bad_github_remote_config <- function(cfg) { +stop_bad_github_remote_config <- function(cfg, call = caller_env()) { ui_abort( github_remote_config_wat(cfg, context = "abort"), class = "usethis_error_bad_github_remote_config", - cfg = cfg + cfg = cfg, + call = call ) } -stop_maybe_github_remote_config <- function(cfg) { +stop_maybe_github_remote_config <- function(cfg, call = caller_env()) { msg <- c( ui_pre_glue(" Pull request functions can't work with GitHub remote configuration: @@ -623,7 +634,8 @@ stop_maybe_github_remote_config <- function(cfg) { ui_abort( message = unlist(msg), class = "usethis_error_invalid_pr_config", - cfg = cfg + cfg = cfg, + call = call ) } @@ -633,23 +645,25 @@ check_for_bad_config <- function(cfg, "fork_upstream_is_not_origin_parent", "fork_cannot_push_origin", "upstream_but_origin_is_not_fork" - )) { + ), + call = caller_env()) { if (cfg$type %in% bad_configs) { - stop_bad_github_remote_config(cfg) + stop_bad_github_remote_config(cfg, call = call) } invisible() } -check_for_maybe_config <- function(cfg) { +check_for_maybe_config <- function(cfg, call = caller_env()) { maybe_configs <- grep("^maybe_", all_configs(), value = TRUE) if (cfg$type %in% maybe_configs) { - stop_maybe_github_remote_config(cfg) + stop_maybe_github_remote_config(cfg, call = call) } invisible() } check_for_config <- function(cfg = NULL, - ok_configs = c("ours", "fork", "theirs")) { + ok_configs = c("ours", "fork", "theirs"), + call = caller_env()) { cfg <- cfg %||% github_remote_config(github_get = TRUE) stopifnot(inherits(cfg, "github_remote_config")) @@ -657,25 +671,27 @@ check_for_config <- function(cfg = NULL, return(invisible(cfg)) } - check_for_maybe_config(cfg) + check_for_maybe_config(cfg, call = call) bad_configs <- grep("^maybe_", all_configs(), invert = TRUE, value = TRUE) bad_configs <- setdiff(bad_configs, ok_configs) - check_for_bad_config(cfg, bad_configs = bad_configs) + check_for_bad_config(cfg, bad_configs = bad_configs, call = call) - ui_abort(" - Internal error: Unexpected GitHub remote configuration: {.val {cfg$type}}.") + ui_abort( + "Internal error: Unexpected GitHub remote configuration: {.val {cfg$type}}.", + call = call + ) } check_can_push <- function(tr = target_repo(github_get = TRUE), - objective = "for this operation") { + objective = "for this operation", call = caller_env()) { if (isTRUE(tr$can_push)) { return(invisible()) } ui_abort(" You don't seem to have push access for {.val {tr$repo_spec}}, which - is required {objective}.") + is required {objective}.", call = call) } # github remote configurations ------------------------------------------------- diff --git a/R/utils-ui.R b/R/utils-ui.R index fa0a9b187..94ac32a76 100644 --- a/R/utils-ui.R +++ b/R/utils-ui.R @@ -139,7 +139,7 @@ usethis_map_cli.default <- function(x, ...) { ui_abort(c( "x" = "Don't know how to {.fun usethis_map_cli} an object of class {.obj_type_friendly {x}}." - )) + ), call = parent.frame()) } #' @export @@ -205,7 +205,7 @@ ui_special <- function(x = "unset") { } # errors ----------------------------------------------------------------------- -ui_abort <- function(message, ..., class = NULL, .envir = parent.frame()) { +ui_abort <- function(message, ..., class = NULL, .envir = parent.frame(), call = NULL) { cli::cli_div(theme = usethis_theme()) nms <- names2(message) @@ -218,6 +218,7 @@ ui_abort <- function(message, ..., class = NULL, .envir = parent.frame()) { message, class = c(class, "usethis_error"), .envir = .envir, + call = call, ... ) } @@ -232,7 +233,9 @@ ui_yep <- function(x, ui_abort(c( "User input required, but session is not interactive.", "Query: {.val {x}}" - )) + ), + call = .envir + ) } n_yes <- min(n_yes, length(yes)) diff --git a/tests/testthat/_snaps/author.md b/tests/testthat/_snaps/author.md index 48bbed63c..9c9028980 100644 --- a/tests/testthat/_snaps/author.md +++ b/tests/testthat/_snaps/author.md @@ -10,7 +10,7 @@ [ ] Convert to 'Authors@R' with `desc::desc_coerce_authors_at_r()`, then delete the legacy fields. Condition - Error in `ui_yep()`: + Error: x User input required, but session is not interactive. i Query: "Do you want to cancel this operation and sort that out first?" @@ -19,7 +19,7 @@ Code use_author("Jennifer", "Bryan", role = "cph") Condition - Error in `check_author_is_novel()`: + Error in `use_author()`: x "Jennifer Bryan" already appears in 'Authors@R'. Please make the desired change directly in DESCRIPTION or call the desc package directly. diff --git a/tests/testthat/_snaps/badge.md b/tests/testthat/_snaps/badge.md index a212bab6b..d71a816da 100644 --- a/tests/testthat/_snaps/badge.md +++ b/tests/testthat/_snaps/badge.md @@ -28,7 +28,7 @@ Code use_posit_cloud_badge("http://posit.cloud/123") Condition - Error in `use_posit_cloud_badge()`: + Error: x `usethis::use_posit_cloud_badge()` requires a link to an existing Posit Cloud project of the form "https://posit.cloud/content/" or "https://posit.cloud/spaces//content/". --- @@ -36,7 +36,7 @@ Code use_rscloud_badge("https://rstudio.cloud/content/123") Condition - Error in `use_posit_cloud_badge()`: + Error: x `usethis::use_posit_cloud_badge()` requires a link to an existing Posit Cloud project of the form "https://posit.cloud/content/" or "https://posit.cloud/spaces//content/". --- @@ -44,6 +44,6 @@ Code use_rscloud_badge("https://posit.cloud/project/123") Condition - Error in `use_posit_cloud_badge()`: + Error: x `usethis::use_posit_cloud_badge()` requires a link to an existing Posit Cloud project of the form "https://posit.cloud/content/" or "https://posit.cloud/spaces//content/". diff --git a/tests/testthat/_snaps/github-actions.md b/tests/testthat/_snaps/github-actions.md index e11c0056e..4d1630d5c 100644 --- a/tests/testthat/_snaps/github-actions.md +++ b/tests/testthat/_snaps/github-actions.md @@ -34,7 +34,7 @@ Code check_uses_github_actions() Condition - Error in `check_uses_github_actions()`: + Error: x Cannot detect that package {TESTPKG} already uses GitHub Actions. i Do you need to run `use_github_action()`? diff --git a/tests/testthat/_snaps/github.md b/tests/testthat/_snaps/github.md index d1be44e33..833835ead 100644 --- a/tests/testthat/_snaps/github.md +++ b/tests/testthat/_snaps/github.md @@ -3,6 +3,6 @@ Code use_github_links(overwrite = FALSE) Condition - Error in `proj_desc_field_update()`: + Error: x 'URL' has a different value in DESCRIPTION. Use `overwrite = TRUE` to overwrite. diff --git a/tests/testthat/_snaps/package.md b/tests/testthat/_snaps/package.md index d6de8b628..9a2b72fc0 100644 --- a/tests/testthat/_snaps/package.md +++ b/tests/testthat/_snaps/package.md @@ -16,7 +16,7 @@ Code use_package("R") Condition - Error in `use_dependency()`: + Error: x Set `type = "Depends"` when specifying an R version. --- @@ -24,7 +24,7 @@ Code use_package("R", type = "Depends") Condition - Error in `use_dependency()`: + Error: x Specify `min_version` when `package = "R"`. --- diff --git a/tests/testthat/_snaps/proj.md b/tests/testthat/_snaps/proj.md index 2d90f6aa1..f503d8ede 100644 --- a/tests/testthat/_snaps/proj.md +++ b/tests/testthat/_snaps/proj.md @@ -3,7 +3,7 @@ Code check_is_package("foo()") Condition - Error in `check_is_package()`: + Error: i foo() (`?usethis::foo`) is designed to work with packages. x Project "{TESTPROJ}" is not an R package. @@ -12,7 +12,7 @@ Code proj_path(c("/a", "b", "/c")) Condition - Error in `proj_path()`: + Error: x Paths must be relative to the active project, not absolute. --- @@ -20,7 +20,7 @@ Code proj_path("/a", "b", "/c") Condition - Error in `proj_path()`: + Error: x Paths must be relative to the active project, not absolute. --- @@ -28,6 +28,6 @@ Code proj_path("/a", c("b", "/c")) Condition - Error in `proj_path()`: + Error: x Paths must be relative to the active project, not absolute. diff --git a/tests/testthat/_snaps/use_import_from.md b/tests/testthat/_snaps/use_import_from.md index 857fe0ef3..e4f11a9a1 100644 --- a/tests/testthat/_snaps/use_import_from.md +++ b/tests/testthat/_snaps/use_import_from.md @@ -11,18 +11,18 @@ Code use_import_from(1) Condition - Error in `use_import_from()`: + Error: x `package` must be a single string. Code use_import_from(c("tibble", "rlang")) Condition - Error in `use_import_from()`: + Error: x `package` must be a single string. Code use_import_from("tibble", "pool_noodle") Condition Error in `map2()`: i In index: 1. - Caused by error in `.f()`: + Caused by error: x Can't find `tibble::pool_noodle()`. diff --git a/tests/testthat/_snaps/utils-github.md b/tests/testthat/_snaps/utils-github.md index d8d1feb03..19ee7f1da 100644 --- a/tests/testthat/_snaps/utils-github.md +++ b/tests/testthat/_snaps/utils-github.md @@ -154,7 +154,7 @@ Code stop_bad_github_remote_config(cfg) Condition - Error in `stop_bad_github_remote_config()`: + Error: x Unsupported GitHub remote configuration: "fork_upstream_is_not_origin_parent" * Host = "https://github.com" * origin = "jennybc/gh" (can push) = fork of "r-lib/gh" @@ -168,7 +168,7 @@ Code stop_bad_github_remote_config(new_fork_upstream_is_not_origin_parent()) Condition - Error in `stop_bad_github_remote_config()`: + Error: x Unsupported GitHub remote configuration: "fork_upstream_is_not_origin_parent" * Host = "https://github.com" * origin = "CONTRIBUTOR/REPO" (can push) = fork of "NEW_OWNER/REPO" @@ -182,7 +182,7 @@ Code stop_maybe_github_remote_config(new_maybe_fork()) Condition - Error in `stop_maybe_github_remote_config()`: + Error: x Pull request functions can't work with GitHub remote configuration: "maybe_fork". i The most likely problem is that we aren't discovering your GitHub personal access token. * Host = "https://github.com" diff --git a/tests/testthat/_snaps/utils.md b/tests/testthat/_snaps/utils.md index dd26dff81..ac98422a5 100644 --- a/tests/testthat/_snaps/utils.md +++ b/tests/testthat/_snaps/utils.md @@ -3,7 +3,7 @@ Code user_facing_function(NULL) Condition - Error in `check_is_named_list()`: + Error: x `somevar` must be a list, not NULL. --- @@ -11,7 +11,7 @@ Code user_facing_function(c(a = "a", b = "b")) Condition - Error in `check_is_named_list()`: + Error: x `somevar` must be a list, not a character vector. --- @@ -19,6 +19,6 @@ Code user_facing_function(list("a", b = 2)) Condition - Error in `check_is_named_list()`: + Error: x Names of `somevar` must be non-missing, non-empty, and non-duplicated. diff --git a/tests/testthat/_snaps/vignette.md b/tests/testthat/_snaps/vignette.md index e7359ae1b..7d3ba4735 100644 --- a/tests/testthat/_snaps/vignette.md +++ b/tests/testthat/_snaps/vignette.md @@ -8,7 +8,7 @@ Code use_vignette("bad name") Condition - Error in `check_vignette_name()`: + Error: x "bad name" is not a valid filename for a vignette. It must: i Start with a letter. i Contain only letters, numbers, '_', and '-'.