Improve error traceback

NEWS.md

@@ -10,6 +10,8 @@
 
 - A warning will be issued when chunk options are duplicated in both the chunk header and pipe comments (thanks, @cderv, #2386). A chunk option should appear in only one of these places.
 
+- Improve error traceback when **rlang** is available and **evaluate** > 1.0.3 is used.
+
 # CHANGES IN knitr VERSION 1.49
 
 ## NEW FEATURES

R/output.R

@@ -309,12 +309,14 @@ process_file = function(text, output) {
     group = groups[[i]]
     knit_concord$set(block = i)
     res[i] = xfun:::handle_error(
-      withCallingHandlers(
-        if (tangle) process_tangle(group) else process_group(group),
-        error = function(e) {
-          if (progress && is.function(pb$interrupt)) pb$interrupt()
-          if (xfun::pkg_available('rlang', '1.0.0')) rlang::entrace(e)
-        }
+      with_options(
+  	    withCallingHandlers(
+          if (tangle) process_tangle(group) else process_group(group),
+          error = function(e) {
+            if (progress && is.function(pb$interrupt)) pb$interrupt()
+          }
+        ),
+        list(rlang_trace_top_env = knit_global())
       ),
       function(loc) {
         setwd(wd)
@@ -715,6 +717,10 @@ add_html_caption = function(options, code, id = NULL) {
 #' # after you define and register the above method, data frames will be printed
 #' # as tables in knitr, which is different with the default print() behavior
 knit_print = function(x, ...) {
+  if (getOption('knitr.in.progress', FALSE)) {
+    current_env = parent.frame()
+    local_options(list(rlang_trace_top_env = current_env))
+  }
   if (need_screenshot(x, ...)) {
     html_screenshot(x)
   } else {

R/utils.R

@@ -864,6 +864,8 @@ current_input = function(dir = FALSE) {
 
 # cache output handlers from evaluate; see .onLoad
 default_handlers = NULL
+# use rlang handler for error only if available; see .onLoad
+rlang_entrace_handler = NULL
 # change the value handler in evaluate default handlers
 knit_handlers = function(fun, options) {
   if (!is.function(fun)) fun = function(x, ...) {
@@ -881,7 +883,7 @@ knit_handlers = function(fun, options) {
     value = function(x, visible) {
       if (visible) fun(x, options = options)
     },
-    calling_handlers = options$calling.handlers
+    calling_handlers = c(options$calling.handlers, rlang_entrace_handler)
   ))
 }
 
@@ -1146,3 +1148,20 @@ txt_pb = function(total, labels) {
 }
 
 is_quarto = function() isTRUE(.knitEnv$is_quarto)
+
+with_options = function(expr, opts_list) {
+  old <- options(opts_list)
+  defer(options(old))
+  local_options(opts_list)
+  expr
+}
+
+local_options <- function(opts_list, .local_envir = parent.frame()) {
+  old <- options(opts_list)
+  defer(options(old), .local_envir)
+}
+
+defer = function(expr, frame = parent.frame(), after = FALSE) {
+  thunk <- as.call(list(function() expr))
+  do.call(on.exit, list(thunk, add = TRUE, after = after), envir = frame)
+}

R/zzz.R

@@ -1,5 +1,12 @@
+has_rlang = FALSE
+
 .onLoad = function(lib, pkg) {
   register_vignette_engines(pkg)
 
   default_handlers <<- evaluate::new_output_handler()
+
+  has_rlang <<- requireNamespace("rlang", quietly = TRUE)
+
+  if (has_rlang)
+    rlang_entrace_handler <<- list(error = function(e) rlang::entrace(e))
 }