Add knit_cnd_format() generic

DESCRIPTION

@@ -143,7 +143,8 @@ Suggests:
     bslib,
     ragg,
     styler (>= 1.2.0),
-    targets (>= 0.6.0)
+    targets (>= 0.6.0),
+    rlang
 License: GPL
 URL: https://yihui.org/knitr/
 BugReports: https://github.com/yihui/knitr/issues

NAMESPACE

@@ -2,6 +2,9 @@
 
 S3method("$",knitr_strict_list)
 S3method(is_low_change,default)
+S3method(knit_cnd_format,error)
+S3method(knit_cnd_format,message)
+S3method(knit_cnd_format,warning)
 S3method(knit_print,default)
 S3method(knit_print,knit_asis)
 S3method(knit_print,knit_asis_url)
@@ -81,6 +84,7 @@ export(knit2pandoc)
 export(knit2pdf)
 export(knit2wp)
 export(knit_child)
+export(knit_cnd_format)
 export(knit_code)
 export(knit_engines)
 export(knit_exit)

NEWS.md

@@ -74,6 +74,8 @@
 
   This engine also works for other types of documents (e.g., `Rnw`) but it will not allow for nested code chunks within the `verbatim` engine.
 
+* New `knit_cnd_format()` generic. It is called by the condition methods for `sew()`. Methods should return a full condition message, including the prefix (e.g. `Error:` or `Warning:`, including a call if the condition includes one).
+
 ## BUG FIXES
 
 - The chunk option `child` also respects the package option `root.dir` now (thanks, @salim-b, https://community.rstudio.com/t/117563).

R/output.R

@@ -529,23 +529,60 @@ msg_sanitize = function(message, type) {
 
 #' @export
 sew.warning = function(x, options, ...) {
-  call = if (is.null(x$call)) '' else {
-    call = deparse(x$call)[1]
-    if (call == 'eval(expr, envir, enclos)') '' else paste(' in', call)
+  if (is_eval_call(x$call)) {
+    x$call = NULL
   }
-  msg_wrap(sprintf('Warning%s: %s', call, conditionMessage(x)), 'warning', options)
+  msg_wrap(knit_cnd_format(x), 'warning', options)
+}
+is_eval_call = function(x) {
+  is.call(x) && identical(x[1], quote(eval()))
 }
 
 #' @export
 sew.message = function(x, options, ...) {
-  msg_wrap(paste(conditionMessage(x), collapse = ''), 'message', options)
+  msg_wrap(knit_cnd_format(x), 'message', options)
 }
 
 #' @export
 sew.error = function(x, options, ...) {
-  msg_wrap(as.character(x), 'error', options)
+  msg_wrap(knit_cnd_format(x), 'error', options)
+}
+
+#' Format a condition prior to sewing
+#'
+#' This generic is called by condition methods for
+#' \code{\link{sew}()}. Methods should return a full condition
+#' message, including the prefix (e.g. `Error:` or `Warning:`,
+#' including a call if the condition includes one).
+#'
+#' @keywords internal
+#' @export
+knit_cnd_format = function(cnd) {
+  UseMethod("knit_cnd_format")
+}
+
+#' @export
+knit_cnd_format.message = function(cnd) {
+  conditionMessage(cnd)
 }
 
+#' @export
+knit_cnd_format.warning = function(cnd) {
+  call = conditionCall(cnd)
+  if (is.null(call)) {
+    call = ''
+  } else {
+    call = paste(' in', deparse(call))[1]
+  }
+  sprintf('Warning%s: %s', call, conditionMessage(cnd))
+}
+
+#' @export
+knit_cnd_format.error = function(cnd) {
+  as.character(cnd)
+}
+
+
 #' @export
 sew.recordedplot = function(x, options, ...) {
   # figure number sequence for multiple plots

tests/testit/test-output.R

@@ -119,3 +119,76 @@ assert('knit_meta_add() adds meta objects with the correct number of labels', {
   knit_meta(clean = TRUE)
   (m %==% c('', '', 'a', 'b'))
 })
+
+assert('sew() handles conditions',
+  identical(
+    sew(simpleError('msg', call = call('foo')), list()),
+    'Error in foo(): msg\n'
+  ),
+  identical(
+    sew(simpleWarning('msg', call = call('foo')), list()),
+    'Warning in foo(): msg\n'
+  ),
+  identical(
+    sew(simpleMessage('msg', call = call('foo')), list()),
+    'msg\n'
+  )
+)
+
+local({
+  assert('sew() strips `eval()` calls stored in warnings', {
+    cnd = tryCatch(
+      warning = identity,
+      eval(quote(warning("foo")))
+    )
+    identical(
+      sew(cnd, list()),
+      'Warning: foo\n'
+    )
+  })
+})
+
+local({
+  assert('knit_cnd_format() formats conditions', {
+    cnd = simpleMessage('msg', call = quote(foo()))
+    identical(
+      knit_cnd_format(cnd),
+      'msg'
+    )
+  }, {
+    cnd = simpleWarning('msg', call = quote(foo()))
+    identical(
+      knit_cnd_format(cnd),
+      'Warning in foo(): msg'
+    )
+  }, {
+    cnd = simpleWarning('msg', call = quote({ foo; bar; baz }))
+    identical(
+      knit_cnd_format(cnd),
+      'Warning in {: msg'
+    )
+  }, {
+    cnd = simpleMessage('msg', call = quote(foo()))
+    identical(
+      knit_cnd_format(cnd),
+      'msg'
+    )
+  })
+})
+
+local({
+  rlang::local_bindings(
+    .env = globalenv(),
+    knit_cnd_format.knitr_foobar = function(cnd) 'dispatched!'
+  )
+  assert('sew() dispatches on knit_cnd_format() with condition objects', {
+    cnd = structure(
+      list(message = 'foo'),
+      class = c('knitr_foobar', 'error', 'condition')
+    )
+    identical(
+      sew(cnd, list()),
+      'dispatched!\n'
+    )
+  })
+})