From a1c756a31e4c1d7da0206bb34ab6425c065a1853 Mon Sep 17 00:00:00 2001
From: Jay Hesselberth <jay.hesselberth@gmail.com>
Date: Wed, 29 Nov 2023 15:35:11 -0700
Subject: [PATCH] add more calls and update snapshots

that should be all of them, there are so many
---
 R/build-articles.R                             | 15 ++++++++++++---
 R/build-home-index.R                           | 12 ++++++++----
 R/build-news.R                                 | 13 ++++++++-----
 R/build-redirects.R                            |  5 ++++-
 R/init.R                                       |  5 ++++-
 R/markdown.R                                   |  1 +
 R/package.R                                    | 11 +++++++----
 R/rd-example.R                                 | 12 +++++++++---
 R/rd-html.R                                    |  5 ++++-
 R/render.R                                     |  5 ++++-
 R/rmarkdown.R                                  |  2 +-
 R/templates.R                                  | 10 ++++++++--
 R/theme.R                                      |  9 ++++++---
 R/topics-external.R                            |  5 ++++-
 R/usage.R                                      | 15 ++++++++++++---
 R/utils-fs.R                                   |  5 ++++-
 tests/testthat/_snaps/build-reference-index.md |  2 +-
 tests/testthat/_snaps/check.md                 |  2 +-
 tests/testthat/_snaps/rd-html.md               |  2 +-
 tests/testthat/_snaps/topics-external.md       |  2 +-
 20 files changed, 100 insertions(+), 38 deletions(-)

diff --git a/R/build-articles.R b/R/build-articles.R
index f3f165a5a..1f4292512 100644
--- a/R/build-articles.R
+++ b/R/build-articles.R
@@ -207,7 +207,10 @@ build_article <- function(name,
   # allow code sharing with building of the index.
   vig <- match(name, pkg$vignettes$name)
   if (is.na(vig)) {
-    cli::cli_abort("Can't find article {.file {name}}")
+    cli::cli_abort(
+      "Can't find article {.file {name}}",
+      call = caller_env()
+    )
   }
 
   input <- pkg$vignettes$file_in[vig]
@@ -368,7 +371,10 @@ data_articles_index <- function(pkg = ".") {
   missing <- setdiff(pkg$vignettes$name, c(listed, pkg$package))
 
   if (length(missing) > 0) {
-    cli::cli_abort("{cli::qty(missing)} Vignette{?s} missing from index: {.file {missing}}")
+    cli::cli_abort(
+      "{cli::qty(missing)} Vignette{?s} missing from index: {.file {missing}}",
+      call = caller_env()
+    )
   }
 
   print_yaml(list(
@@ -379,7 +385,10 @@ data_articles_index <- function(pkg = ".") {
 
 data_articles_index_section <- function(section, pkg) {
   if (!set_contains(names(section), c("title", "contents"))) {
-    cli::cli_abort("Section must have components {.field title}, {.field contents}")
+    cli::cli_abort(
+      "Section must have components {.field title}, {.field contents}",
+      call = caller_env()
+    )
   }
 
   # Match topics against any aliases
diff --git a/R/build-home-index.R b/R/build-home-index.R
index 516808b20..86b99782a 100644
--- a/R/build-home-index.R
+++ b/R/build-home-index.R
@@ -70,10 +70,14 @@ data_home_sidebar <- function(pkg = ".") {
         pkg, c('home', 'sidebar', 'html'), fmt = TRUE, cfg = TRUE
       )
 
-      cli::cli_abort(c(
-        "Can't locate {.file {rel_html_path}}.",
-        x = paste0(msg_fld, " is misconfigured.")
-      ))
+      cli::cli_abort(
+        c(
+          "Can't locate {.file {rel_html_path}}.",
+          x = paste0(msg_fld, " is misconfigured.")
+        ),
+        call = caller_env()
+      )
+
 
     }
     return(read_file(html_path))
diff --git a/R/build-news.R b/R/build-news.R
index 34d145df2..03643affb 100644
--- a/R/build-news.R
+++ b/R/build-news.R
@@ -160,11 +160,14 @@ data_news <- function(pkg = list()) {
     xml2::xml_name()
   ulevels <- unique(levels)
   if (!identical(ulevels, "h1") && !identical(ulevels, "h2")) {
-    cli::cli_abort(c(
-      "Invalid NEWS.md: inconsistent use of section headings.",
-      i = "Top-level headings must be either all <h1> or all <h2>.",
-      i = "See {.help pkgdown::build_news} for more details."
-    ))
+    cli::cli_abort(
+      c(
+        "Invalid NEWS.md: inconsistent use of section headings.",
+        i = "Top-level headings must be either all <h1> or all <h2>.",
+        i = "See {.help pkgdown::build_news} for more details."
+      ),
+      call = caller_env()
+    )
   }
   if (ulevels == "h1") {
     # Bump every heading down a level so to get a single <h1> for the page title
diff --git a/R/build-redirects.R b/R/build-redirects.R
index 9a8fda362..9bd64871f 100644
--- a/R/build-redirects.R
+++ b/R/build-redirects.R
@@ -14,7 +14,10 @@ build_redirects <- function(pkg = ".",
   cli::cli_rule("Building redirects")
   if (is.null(pkg$meta$url)) {
     msg_fld <- pkgdown_field(pkg, "url", cfg = TRUE, fmt = TRUE)
-    cli::cli_abort(paste0(msg_fld, " is required to generate redirects."))
+    cli::cli_abort(
+      paste0(msg_fld, " is required to generate redirects."),
+      call = caller_env()
+    )
   }
 
   purrr::iwalk(
diff --git a/R/init.R b/R/init.R
index ac6d87b87..8946dfd86 100644
--- a/R/init.R
+++ b/R/init.R
@@ -24,7 +24,10 @@ init_site <- function(pkg = ".") {
   pkg <- as_pkgdown(pkg)
 
   if (is_non_pkgdown_site(pkg$dst_path)) {
-    cli::cli_abort("{.file {pkg$dst_path}} is non-empty and not built by pkgdown")
+    cli::cli_abort(
+      "{.file {pkg$dst_path}} is non-empty and not built by pkgdown",
+      call = caller_env()
+    )
   }
 
   cli::cli_rule("Initialising site")
diff --git a/R/markdown.R b/R/markdown.R
index 2c8189a9e..5574343fe 100644
--- a/R/markdown.R
+++ b/R/markdown.R
@@ -18,6 +18,7 @@ markdown_text_inline <- function(text, where = "<inline>", ...) {
   if (length(children) > 1) {
     cli::cli_abort(
       "Can't use a block element in {.var {where}}, need an inline element: {.var {text}}",
+      call = caller_env()
     )
   }
 
diff --git a/R/package.R b/R/package.R
index c3ea28654..415baf2ef 100644
--- a/R/package.R
+++ b/R/package.R
@@ -296,8 +296,11 @@ check_unique_article_paths <- function(file_in, file_out) {
   })
   names(same_out_bullets) <- rep_len("x", length(same_out_bullets))
 
-  cli::cli_abort(c(
-    "Rendered articles must have unique names. Rename or relocate:",
-    same_out_bullets
-  ))
+  cli::cli_abort(
+    c(
+      "Rendered articles must have unique names. Rename or relocate:",
+      same_out_bullets
+    ),
+    call = caller_env()
+  )
 }
diff --git a/R/rd-example.R b/R/rd-example.R
index 4c025ab8d..ee54d2cf9 100644
--- a/R/rd-example.R
+++ b/R/rd-example.R
@@ -48,13 +48,17 @@ process_conditional_examples <- function(rd) {
         grepl("# examplesIf$", x[[1]])
     }))
     if (length(which_exif) == 0) return(rd)
-    if (length(which_exif) %% 2 != 0) cli::cli_abort("@examplesIf error, not closed?")
+    if (length(which_exif) %% 2 != 0) {
+      cli::cli_abort("@examplesIf error, not closed?", call = caller_env())
+    }
     remove <- integer()
     modes <- c("begin", "end")
     for (idx in which_exif) {
       if (rd[[idx]] != "}) # examplesIf") {
         # Start of @examplesIf
-        if (modes[1] == "end") cli::cli_abort("@examplesIf error, not closed?")
+        if (modes[1] == "end") {
+          cli::cli_abort("@examplesIf error, not closed?", call = caller_env())
+        }
         cond_expr <- parse(text = paste0(rd[[idx]], "\n})"))[[1]][[2]]
         cond <- eval(cond_expr)
         if (isTRUE(cond)) {
@@ -74,7 +78,9 @@ process_conditional_examples <- function(rd) {
         }
       } else {
         # End of @examplesIf
-        if (modes[1] == "begin") cli::cli_abort("@examplesIf error, closed twice?")
+        if (modes[1] == "begin") {
+          cli::cli_abort("@examplesIf error, closed twice?", call = caller_env())
+        }
         if (isTRUE(cond)) {
           remove <- c(remove, idx, idx + 1L)
         } else {
diff --git a/R/rd-html.R b/R/rd-html.R
index 03372285c..2cf26a412 100644
--- a/R/rd-html.R
+++ b/R/rd-html.R
@@ -229,7 +229,10 @@ as_html.tag_Sexpr <- function(x, ...) {
     text = as.character(res),
     rd = flatten_text(rd_text(as.character(res))),
     hide = "",
-    cli::cli_abort("\\\\Sexpr{{result={results}}} not yet supported")
+    cli::cli_abort(
+      "\\\\Sexpr{{result={results}}} not yet supported",
+      call = caller_env()
+    )
   )
 }
 
diff --git a/R/render.R b/R/render.R
index a18560bbd..ec90fcb96 100644
--- a/R/render.R
+++ b/R/render.R
@@ -149,7 +149,10 @@ data_open_graph <- function(pkg = ".") {
 check_open_graph <- function(og) {
   if (!is.list(og)) {
     fog <- friendly_type_of(og)
-    cli::cli_abort("{.var opengraph} must be a list, not {.val fog}")
+    cli::cli_abort(
+      "{.var opengraph} must be a list, not {.val fog}",
+      call = caller_env()
+    )
   }
   supported_fields <- c("image", "twitter")
   unsupported_fields <- setdiff(names(og), supported_fields)
diff --git a/R/rmarkdown.R b/R/rmarkdown.R
index d823fba83..52c937f37 100644
--- a/R/rmarkdown.R
+++ b/R/rmarkdown.R
@@ -7,7 +7,7 @@ render_rmarkdown <- function(pkg, input, output, ..., copy_images = TRUE, quiet
   output_path <- path_abs(output, pkg$dst_path)
 
   if (!file_exists(input_path)) {
-    cli::cli_abort("Can't find {src_path(input)")
+    cli::cli_abort("Can't find {src_path(input)", call = caller_env())
   }
 
   cli::cli_inform("Reading {src_path(input)}")
diff --git a/R/templates.R b/R/templates.R
index 00ec08fa6..54816e4e5 100644
--- a/R/templates.R
+++ b/R/templates.R
@@ -7,7 +7,10 @@ find_template <- function(type, name, ext = ".html", pkg = ".") {
 
   if (length(existing) == 0) {
     tname <- paste0(type, "-", name)
-    cli::cli_abort("Can't find template for {.val {tname}}.")
+    cli::cli_abort(
+      "Can't find template for {.val {tname}}.",
+      call = caller_env()
+    )
   }
   existing[[1]]
 }
@@ -44,7 +47,10 @@ templates_dir <- function(pkg = list()) {
   if (!is.null(template$path)) {
     # Directory specified in yaml doesn't exist, so eagerly error
     if (!dir_exists(template$path)) {
-      cli::cli_abort("Can't find templates path: {src_path(template$path)}")
+      cli::cli_abort(
+        "Can't find templates path: {src_path(template$path)}",
+        call = caller_env()
+      )
     }
     path_abs(template$path, start = pkg$src_path)
   } else if (!is.null(template$package)) {
diff --git a/R/theme.R b/R/theme.R
index 6df16e2ac..eb7e3f142 100644
--- a/R/theme.R
+++ b/R/theme.R
@@ -12,7 +12,10 @@ build_bslib <- function(pkg = ".") {
 
 data_deps <- function(pkg, depth) {
   if (!file.exists(data_deps_path(pkg))) {
-    cli::cli_abort("Run {.fn pkgdown::init_site} first.")
+    cli::cli_abort(
+      "Run {.fn pkgdown::init_site} first.",
+      call = caller_env()
+    )
   }
 
   deps_path <- paste0(up_path(depth), "deps")
@@ -59,7 +62,7 @@ bs_theme_rules <- function(pkg) {
     cli::cli_abort(c(
       "Unknown theme: {.val {theme}}",
       i = "Valid themes are: {.val highlight_styles()}"
-    ))
+    ), call = caller_env())
   }
   paths <- c(paths, theme_path)
 
@@ -110,7 +113,7 @@ check_bootswatch_theme <- function(bootswatch_theme, bs_version, pkg) {
         pkgdown_field(pkg, c("template", "bootstrap"))
       ),
       x = "Edit settings in {.file {pkgdown_config_relpath(pkg)}}"
-    ))
+    ), call = caller_env())
   }
 
 }
diff --git a/R/topics-external.R b/R/topics-external.R
index e0d6620a9..0bd56bd90 100644
--- a/R/topics-external.R
+++ b/R/topics-external.R
@@ -30,7 +30,10 @@ get_rd_from_help <- function(package, alias) {
   help <- utils::help((alias), (package))
   if (length(help) == 0) {
     fun <- paste0(package, "::", alias)
-    cli::cli_abort("Could not find documentation for {.fn {fun}}.")
+    cli::cli_abort(
+      "Could not find documentation for {.fn {fun}}.",
+      call = caller_env()
+    )
     return()
   }
 
diff --git a/R/usage.R b/R/usage.R
index 77e9d0940..aa88be084 100644
--- a/R/usage.R
+++ b/R/usage.R
@@ -86,7 +86,10 @@ usage_type <- function(x) {
     out
   } else {
     untype <- paste0(typeof(x), " (in ", as.character(x), ")")
-    cli::cli_abort("Unknown type: {.val {untype}}")
+    cli::cli_abort(
+      "Unknown type: {.val {untype}}",
+      call = caller_env()
+    )
   }
 }
 
@@ -130,7 +133,10 @@ fun_info <- function(fun) {
         name = call_name(fun)
       )
     } else {
-      cli::cli_abort("Unknown call: {.val {as.character(x[[1]])}}")
+      cli::cli_abort(
+        "Unknown call: {.val {as.character(x[[1]])}}",
+        call = caller_env()
+      )
     }
   } else {
     list(
@@ -161,7 +167,10 @@ usage_code.NULL <- function(x) character()
 #' @export
 usage_code.tag <- function(x) {
   if (!identical(class(x), "tag")) {
-    cli::cli_abort("Undefined tag in usage: {.val class(x)[[1]]}}")
+    cli::cli_abort(
+      "Undefined tag in usage: {.val class(x)[[1]]}}",
+      call = caller_env()
+    )
   }
   paste0(purrr::flatten_chr(purrr::map(x, usage_code)), collapse = "")
 }
diff --git a/R/utils-fs.R b/R/utils-fs.R
index 8cb22a5ca..9e4445da0 100644
--- a/R/utils-fs.R
+++ b/R/utils-fs.R
@@ -55,7 +55,10 @@ out_of_date <- function(source, target) {
     return(TRUE)
 
   if (!file_exists(source)) {
-    cli::cli_abort("{.fn {source}} does not exist")
+    cli::cli_abort(
+      "{.fn {source}} does not exist",
+      call = caller_env()
+    )
   }
 
   file.info(source)$mtime > file.info(target)$mtime
diff --git a/tests/testthat/_snaps/build-reference-index.md b/tests/testthat/_snaps/build-reference-index.md
index aceb87436..13a43f0e2 100644
--- a/tests/testthat/_snaps/build-reference-index.md
+++ b/tests/testthat/_snaps/build-reference-index.md
@@ -94,7 +94,7 @@
       i In index: 1.
       Caused by error in `purrr::map2()`:
       i In index: 1.
-      Caused by error in `.f()`:
+      Caused by error in `map2_()`:
       ! Could not find documentation for `rlang::lala()`.
 
 # can use a topic from another package
diff --git a/tests/testthat/_snaps/check.md b/tests/testthat/_snaps/check.md
index 23dd24cee..769719da0 100644
--- a/tests/testthat/_snaps/check.md
+++ b/tests/testthat/_snaps/check.md
@@ -13,7 +13,7 @@
     Code
       check_pkgdown(pkg)
     Condition
-      Error in `data_articles_index()`:
+      Error in `check_pkgdown()`:
       ! Vignettes missing from index: 'articles/nested' and 'width'
 
 # informs if everything is ok
diff --git a/tests/testthat/_snaps/rd-html.md b/tests/testthat/_snaps/rd-html.md
index 0f687d649..f0d2fb04a 100644
--- a/tests/testthat/_snaps/rd-html.md
+++ b/tests/testthat/_snaps/rd-html.md
@@ -39,7 +39,7 @@
     Condition
       Error in `purrr::map_chr()`:
       i In index: 1.
-      Caused by error in `.f()`:
+      Caused by error in `map_()`:
       ! \\Sexpr{result=verbatim} not yet supported
 
 # bad specs throw errors
diff --git a/tests/testthat/_snaps/topics-external.md b/tests/testthat/_snaps/topics-external.md
index 4584ff7d2..f2f7ab738 100644
--- a/tests/testthat/_snaps/topics-external.md
+++ b/tests/testthat/_snaps/topics-external.md
@@ -28,6 +28,6 @@
     Condition
       Error in `purrr::map2()`:
       i In index: 1.
-      Caused by error in `.f()`:
+      Caused by error in `map2_()`:
       ! Could not find documentation for `base::doesntexist()`.