From 2ffe5e4b681198613e46a6da01552fd0a0fc5edd Mon Sep 17 00:00:00 2001
From: mariusbarth <marius.barth@uni-koeln.de>
Date: Thu, 12 Aug 2021 13:32:05 +0200
Subject: [PATCH 01/17] use a single-line progress bar, addresses #1880

- creates a globally accessible, bespoke progress bar `knit_progress()`
- create `set_knit_progress()` to update value and/or printed text
- also use `cat()` (instead of `message()` for printing information about processed files, to prevent mixing of streams from `stdout` and `stderr`
---
 DESCRIPTION       |  4 ++-
 R/block.R         | 13 ++++++--
 R/knit_progress.R | 80 +++++++++++++++++++++++++++++++++++++++++++++++
 R/output.R        | 22 ++++++-------
 R/parser.R        | 12 ++-----
 5 files changed, 108 insertions(+), 23 deletions(-)
 create mode 100644 R/knit_progress.R

diff --git a/DESCRIPTION b/DESCRIPTION
index 3092d33f5d..ecfcdcd062 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -102,7 +102,8 @@ Authors@R: c(
     person("Viktoras", "Veitas", role = "ctb"),
     person("Weicheng", "Zhu", role = "ctb"),
     person("Wush", "Wu", role = "ctb"),
-    person("Zachary", "Foster", role = "ctb")
+    person("Zachary", "Foster", role = "ctb"),
+    person("Marius", "Barth", role = "ctb", comment = c(ORCID = "0000-0002-3421-6665"))
     )
 Description: Provides a general-purpose tool for dynamic report generation in R
     using Literate Programming techniques.
@@ -172,6 +173,7 @@ Collate:
     'hooks-rst.R'
     'hooks-textile.R'
     'hooks.R'
+    'knit_progress.R'
     'output.R'
     'package.R'
     'pandoc.R'
diff --git a/R/block.R b/R/block.R
index 6958c7aba0..7d76df17f4 100644
--- a/R/block.R
+++ b/R/block.R
@@ -53,7 +53,16 @@ call_block = function(block) {
   # save current chunk options in opts_current
   opts_current$restore(params)
 
-  if (opts_knit$get('progress')) print(block)
+  if (opts_knit$get("progress")) {
+    set_knit_progress("chunk: ", label)
+    if (opts_knit$get('verbose')) {
+      code = knit_code$get(params$label)
+      if(is_blank(code)) break
+      for (i in seq_along(code)) {
+        set_knit_progress(code[[i]])
+      }
+    }
+  }
 
   if (!is.null(params$child)) {
     if (!is_blank(params$code)) warning(
@@ -96,7 +105,7 @@ call_block = function(block) {
     if (cache$exists(hash, params$cache.lazy) &&
         isFALSE(params$cache.rebuild) &&
         params$engine != 'Rcpp') {
-      if (opts_knit$get('verbose')) message('  loading cache from ', hash)
+      if (opts_knit$get('verbose')) set_knit_progress(paste0("Loading cache from ", hash))
       cache$load(hash, lazy = params$cache.lazy)
       cache_engine(params)
       if (!params$include) return('')
diff --git a/R/knit_progress.R b/R/knit_progress.R
new file mode 100644
index 0000000000..ac5afc8b47
--- /dev/null
+++ b/R/knit_progress.R
@@ -0,0 +1,80 @@
+
+knit_progress <- function (
+  max = 1
+  , title
+  , message
+  , style = 1
+) {
+
+  .val <- 0
+  .text <- character(1L)
+  .killed <- FALSE
+  .nb <- 0L
+  .pc <- -1L
+  char = "."
+
+  width <- floor(getOption("width") * 2/5)
+  text_width <- getOption("width") - width - 6
+
+
+  up <- function(value, text, carriage_return = "\r ") {
+
+    nb <- round(width * value/max)
+    pc <- round(100 * value/max)
+
+    if (nb == .nb && pc == .pc && text == .text) return()
+    if (!is.finite(value) || value > max) stop("knitr::knit_progress() 'value' is ", value)
+
+    if(isTRUE(knitr::opts_knit$get("verbose")) && text != .text) carriage_return <- "\n "
+
+    .text <<- text
+    .val <<- value
+
+
+    cat(
+      carriage_return
+      , encodeString(stringr::str_trunc(text, width = text_width), width = text_width)
+      , "|"
+      , rep.int(char, nb)
+      , rep.int(" ", width - nb)
+      , sprintf("| %3d%%", pc)
+      , sep = ""
+    )
+    flush.console()
+    .nb <<- nb
+    .pc <<- pc
+  }
+  getVal <- function() .val
+  getText <- function() .text
+  kill <- function() if (!.killed) {
+    cat("\n")
+    flush.console()
+    .killed <<- TRUE
+  }
+
+  up(value = 0, text = "Knitting...", carriage_return = "\n ")
+  structure(list(getVal = getVal, getText = getText, up = up, kill = kill), class = "txtProgressBar")
+}
+
+
+set_knit_progress <- function(x, ...) {
+  UseMethod("set_knit_progress")
+}
+
+set_knit_progress.character <- function(x, ...) {
+  x <- paste0(x, ..., collapse = "")
+
+  pb <- getOption("knitr.knit_progress")
+  oldval <- pb$getVal()
+  oldtext <- pb$getText()
+  pb$up(value = oldval, text = x)
+  invisible(oldval)
+}
+
+set_knit_progress.numeric <- function(x, ...) {
+  pb <- getOption("knitr.knit_progress")
+  oldval <- pb$getVal()
+  oldtext <- pb$getText()
+  pb$up(value = x, text = oldtext)
+  invisible(oldval)
+}
diff --git a/R/output.R b/R/output.R
index ed50cbe9f7..ce09f1becc 100644
--- a/R/output.R
+++ b/R/output.R
@@ -245,7 +245,7 @@ knit = function(
   }
 
   progress = opts_knit$get('progress')
-  if (in.file && !quiet) message(ifelse(progress, '\n\n', ''), 'processing file: ', input)
+  if (in.file && !quiet) cat("processing file: ", input)
   res = process_file(text, output)
   res = one_string(knit_hooks$get('document')(res))
   if (tangle) res = c(params, res)
@@ -257,7 +257,7 @@ knit = function(
 
   if (in.file && is.character(output) && file.exists(output)) {
     concord_gen(input, output)
-    if (!quiet) message('output file: ', output, ifelse(progress, '\n', ''))
+    if (!quiet) cat("output file: ", output, "\n\n")
   }
 
   output %n% res
@@ -277,18 +277,20 @@ purl = function(..., documentation = 1L) {
 
 process_file = function(text, output) {
   groups = split_file(lines = text)
-  n = length(groups); res = character(n)
-  tangle = opts_knit$get('tangle')
+  n <- length(groups)
+  res <- character(n)
+  tangle <- opts_knit$get('tangle')
 
   # when in R CMD check, turn off the progress bar (R-exts said the progress bar
   # was not appropriate for non-interactive mode, and I don't want to argue)
-  progress = opts_knit$get('progress') && !is_R_CMD_check()
+  progress <- opts_knit$get('progress') && !is_R_CMD_check()
   if (progress) {
-    pb = txtProgressBar(0, n, char = '.', style = 3)
-    on.exit(close(pb), add = TRUE)
+    options(knitr.knit_progress = knit_progress(max = n))
+    on.exit(close(getOption("knitr.knit_progress")), add = TRUE)
   }
   wd = getwd()
-  for (i in 1:n) {
+
+  for (i in seq_len(n)) {
     if (!is.null(.knitEnv$terminate)) {
       if (!child_mode() || !.knitEnv$terminate_fully) {
         # reset the internal variable `terminate` in the top parent
@@ -298,9 +300,7 @@ process_file = function(text, output) {
       break  # must have called knit_exit(), so exit early
     }
     if (progress) {
-      setTxtProgressBar(pb, i)
-      if (!tangle) cat('\n')  # under tangle mode, only show one progress bar
-      flush.console()
+      set_knit_progress(i)
     }
     group = groups[[i]]
     res[i] = withCallingHandlers(
diff --git a/R/parser.R b/R/parser.R
index 156a700d82..bbcdee0b75 100644
--- a/R/parser.R
+++ b/R/parser.R
@@ -222,16 +222,10 @@ parse_inline = function(input, patterns) {
 
 print.inline = function(x, ...) {
   if (nrow(x$location)) {
-    cat('   ')
     if (opts_knit$get('verbose')) {
-      cat(stringr::str_pad(' inline R code fragments ',
-                  getOption('width') - 10L, 'both', '-'), '\n')
-      cat(sprintf('    %s:%s %s', x$location[, 1], x$location[, 2], x$code),
-          sep = '\n')
-      cat('  ', stringr::str_dup('-', getOption('width') - 10L), '\n')
-    } else cat('inline R code fragments\n')
-  } else cat('  ordinary text without R code\n')
-  cat('\n')
+      set_knit_progress("inline code: ", sprintf("%s:%s %s", x$location[, 1], x$location[, 2], x$code))
+    } else  set_knit_progress('inline code')
+  } else set_knit_progress('text')
 }
 
 #' Read chunks from an external script

From 157bbe2aabff0737061cde05cfc3ca2b43c580f7 Mon Sep 17 00:00:00 2001
From: mariusbarth <marius.barth@uni-koeln.de>
Date: Thu, 12 Aug 2021 14:01:14 +0200
Subject: [PATCH 02/17] R CMD CHECK: never call `set_knit_progress()`

---
 R/block.R | 11 ++++++-----
 1 file changed, 6 insertions(+), 5 deletions(-)

diff --git a/R/block.R b/R/block.R
index 7d76df17f4..ed0efdae05 100644
--- a/R/block.R
+++ b/R/block.R
@@ -53,13 +53,14 @@ call_block = function(block) {
   # save current chunk options in opts_current
   opts_current$restore(params)
 
-  if (opts_knit$get("progress")) {
+  if (opts_knit$get("progress") && !is_R_CMD_check()) {
     set_knit_progress("chunk: ", label)
     if (opts_knit$get('verbose')) {
       code = knit_code$get(params$label)
-      if(is_blank(code)) break
-      for (i in seq_along(code)) {
-        set_knit_progress(code[[i]])
+      if(!is_blank(code)) {
+        for (i in seq_along(code)) {
+          set_knit_progress(code[[i]])
+        }
       }
     }
   }
@@ -520,7 +521,7 @@ merge_character = function(res) {
 }
 
 call_inline = function(block) {
-  if (opts_knit$get('progress')) print(block)
+  if (opts_knit$get('progress') && !is_R_CMD_check()) print(block)
   in_dir(input_dir(), inline_exec(block))
 }
 

From e8f9be7c1ca86d1d0da8841c6e198b8fd958764a Mon Sep 17 00:00:00 2001
From: mariusbarth <marius.barth@uni-koeln.de>
Date: Thu, 12 Aug 2021 14:23:42 +0200
Subject: [PATCH 03/17] improve interplay of progress bar and `print_knitlog()`

---
 R/output.R | 1 +
 1 file changed, 1 insertion(+)

diff --git a/R/output.R b/R/output.R
index ce09f1becc..f73358fdb8 100644
--- a/R/output.R
+++ b/R/output.R
@@ -319,6 +319,7 @@ process_file = function(text, output) {
   if (!tangle) res = insert_header(res)  # insert header
   # output line numbers
   if (concord_mode()) knit_concord$set(outlines = line_count(res))
+  close(getOption("knitr.knit_progress")) # ensures that cat('\n') is executed before `print_knitlog()`
   print_knitlog()
   if (tangle) res = strip_white(res)
 

From 0cb242d112174c4791f89c07a1727b88ccc72db4 Mon Sep 17 00:00:00 2001
From: mariusbarth <marius.barth@uni-koeln.de>
Date: Thu, 12 Aug 2021 14:33:41 +0200
Subject: [PATCH 04/17] give credit to utils package

---
 R/knit_progress.R | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/R/knit_progress.R b/R/knit_progress.R
index ac5afc8b47..69fa5103e3 100644
--- a/R/knit_progress.R
+++ b/R/knit_progress.R
@@ -1,4 +1,7 @@
 
+# Functions in this file are derived from utils::txtProgressBar(),
+# author: R Core Team and contributors worldwide
+
 knit_progress <- function (
   max = 1
   , title

From 223175b64135af94b85f98c00efc590d61c17052 Mon Sep 17 00:00:00 2001
From: mariusbarth <marius.barth@uni-koeln.de>
Date: Thu, 12 Aug 2021 14:48:07 +0200
Subject: [PATCH 05/17] handle edge cases w/o progress bar

---
 R/output.R | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/R/output.R b/R/output.R
index f73358fdb8..43d6a7a348 100644
--- a/R/output.R
+++ b/R/output.R
@@ -319,7 +319,7 @@ process_file = function(text, output) {
   if (!tangle) res = insert_header(res)  # insert header
   # output line numbers
   if (concord_mode()) knit_concord$set(outlines = line_count(res))
-  close(getOption("knitr.knit_progress")) # ensures that cat('\n') is executed before `print_knitlog()`
+  if(progress) close(getOption("knitr.knit_progress")) # ensures that cat('\n') is executed before `print_knitlog()`
   print_knitlog()
   if (tangle) res = strip_white(res)
 

From 5d991d60605e234e148f4c69e0f4228082657a7a Mon Sep 17 00:00:00 2001
From: mariusbarth <marius.barth@uni-koeln.de>
Date: Thu, 12 Aug 2021 16:38:13 +0200
Subject: [PATCH 06/17] improve handling of child documents and messages

---
 R/block.R         |  1 +
 R/knit_progress.R |  2 +-
 R/output.R        | 36 +++++++++++++++++++++++-------------
 3 files changed, 25 insertions(+), 14 deletions(-)

diff --git a/R/block.R b/R/block.R
index ed0efdae05..86846fc43c 100644
--- a/R/block.R
+++ b/R/block.R
@@ -73,6 +73,7 @@ call_block = function(block) {
     if (!params$eval) return('')
     cmds = lapply(sc_split(params$child), knit_child, options = block$params)
     out = one_string(unlist(cmds))
+    set_knit_progress("child: ", params$child)
     return(out)
   }
 
diff --git a/R/knit_progress.R b/R/knit_progress.R
index 69fa5103e3..48df714eb3 100644
--- a/R/knit_progress.R
+++ b/R/knit_progress.R
@@ -17,7 +17,7 @@ knit_progress <- function (
   char = "."
 
   width <- floor(getOption("width") * 2/5)
-  text_width <- getOption("width") - width - 6
+  text_width <- getOption("width") - width - 7
 
 
   up <- function(value, text, carriage_return = "\r ") {
diff --git a/R/output.R b/R/output.R
index 43d6a7a348..ca95ab1a54 100644
--- a/R/output.R
+++ b/R/output.R
@@ -245,7 +245,7 @@ knit = function(
   }
 
   progress = opts_knit$get('progress')
-  if (in.file && !quiet) cat("processing file: ", input)
+  if (in.file && !quiet && !child_mode()) cat("processing file: ", input)
   res = process_file(text, output)
   res = one_string(knit_hooks$get('document')(res))
   if (tangle) res = c(params, res)
@@ -284,7 +284,7 @@ process_file = function(text, output) {
   # when in R CMD check, turn off the progress bar (R-exts said the progress bar
   # was not appropriate for non-interactive mode, and I don't want to argue)
   progress <- opts_knit$get('progress') && !is_R_CMD_check()
-  if (progress) {
+  if (progress && !child_mode()) {
     options(knitr.knit_progress = knit_progress(max = n))
     on.exit(close(getOption("knitr.knit_progress")), add = TRUE)
   }
@@ -299,27 +299,37 @@ process_file = function(text, output) {
       }
       break  # must have called knit_exit(), so exit early
     }
-    if (progress) {
+    if (progress && !child_mode()) {
       set_knit_progress(i)
     }
     group = groups[[i]]
-    res[i] = withCallingHandlers(
-      if (tangle) process_tangle(group) else process_group(group),
-      error = function(e) {
-        setwd(wd)
-        cat(res, sep = '\n', file = output %n% '')
-        message(
-          'Quitting from lines ', paste(current_lines(i), collapse = '-'),
-          ' (', knit_concord$get('infile'), ') '
-        )
+
+    messages <- capture.output(
+      {
+      res[i] = withCallingHandlers(
+        if (tangle) process_tangle(group) else process_group(group),
+        error = function(e) {
+          setwd(wd)
+          cat(res, sep = '\n', file = output %n% '')
+          message(
+            'Quitting from lines ', paste(current_lines(i), collapse = '-'),
+            ' (', knit_concord$get('infile'), ') '
+          )
+        }
+      )
       }
+      , type = "message"
     )
+    if(length(messages)) {
+      cat("\r", strrep(" ", getOption("width")))
+      cat("\r", messages, sep = "\n")
+    }
   }
 
   if (!tangle) res = insert_header(res)  # insert header
   # output line numbers
   if (concord_mode()) knit_concord$set(outlines = line_count(res))
-  if(progress) close(getOption("knitr.knit_progress")) # ensures that cat('\n') is executed before `print_knitlog()`
+  if(progress && !child_mode()) close(getOption("knitr.knit_progress")) # ensures that cat('\n') is executed before `print_knitlog()`
   print_knitlog()
   if (tangle) res = strip_white(res)
 

From 69ec0d9406502446710037eed6bade581cad1f8b Mon Sep 17 00:00:00 2001
From: mariusbarth <marius.barth@uni-koeln.de>
Date: Thu, 12 Aug 2021 17:19:59 +0200
Subject: [PATCH 07/17] set_knit_progress(): handle edge cases when no progress
 bar is defined

---
 R/knit_progress.R | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/R/knit_progress.R b/R/knit_progress.R
index 48df714eb3..2ae0b483e8 100644
--- a/R/knit_progress.R
+++ b/R/knit_progress.R
@@ -68,6 +68,7 @@ set_knit_progress.character <- function(x, ...) {
   x <- paste0(x, ..., collapse = "")
 
   pb <- getOption("knitr.knit_progress")
+  if(is.null(pb)) return()
   oldval <- pb$getVal()
   oldtext <- pb$getText()
   pb$up(value = oldval, text = x)
@@ -76,6 +77,7 @@ set_knit_progress.character <- function(x, ...) {
 
 set_knit_progress.numeric <- function(x, ...) {
   pb <- getOption("knitr.knit_progress")
+  if(is.null(pb)) return()
   oldval <- pb$getVal()
   oldtext <- pb$getText()
   pb$up(value = x, text = oldtext)

From acf364a8b1cb442fdaa1e766ec94b18ae85e1a9a Mon Sep 17 00:00:00 2001
From: mariusbarth <marius.barth@uni-koeln.de>
Date: Thu, 12 Aug 2021 18:39:04 +0200
Subject: [PATCH 08/17] minor improvement to typesetting

---
 R/knit_progress.R | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/R/knit_progress.R b/R/knit_progress.R
index 2ae0b483e8..7cf46de23c 100644
--- a/R/knit_progress.R
+++ b/R/knit_progress.R
@@ -36,7 +36,7 @@ knit_progress <- function (
 
     cat(
       carriage_return
-      , encodeString(stringr::str_trunc(text, width = text_width), width = text_width)
+      , stringr::str_trunc(encodeString(text, width = text_width), width = text_width)
       , "|"
       , rep.int(char, nb)
       , rep.int(" ", width - nb)

From 073d96b4cee731ac8d7dde7d46019a2b6fe5fd89 Mon Sep 17 00:00:00 2001
From: mariusbarth <marius.barth@uni-koeln.de>
Date: Thu, 12 Aug 2021 23:05:56 +0200
Subject: [PATCH 09/17] much-improved handling of intermediate messages

---
 R/knit_progress.R |  2 +-
 R/output.R        | 42 +++++++++++++++++++++++++-----------------
 2 files changed, 26 insertions(+), 18 deletions(-)

diff --git a/R/knit_progress.R b/R/knit_progress.R
index 7cf46de23c..9494fe8f92 100644
--- a/R/knit_progress.R
+++ b/R/knit_progress.R
@@ -17,7 +17,7 @@ knit_progress <- function (
   char = "."
 
   width <- floor(getOption("width") * 2/5)
-  text_width <- getOption("width") - width - 7
+  text_width <- getOption("width") - width - 8
 
 
   up <- function(value, text, carriage_return = "\r ") {
diff --git a/R/output.R b/R/output.R
index ca95ab1a54..d9a58fd7ba 100644
--- a/R/output.R
+++ b/R/output.R
@@ -278,7 +278,7 @@ purl = function(..., documentation = 1L) {
 process_file = function(text, output) {
   groups = split_file(lines = text)
   n <- length(groups)
-  res <- character(n)
+  res <- vector(mode = "list", length = n)
   tangle <- opts_knit$get('tangle')
 
   # when in R CMD check, turn off the progress bar (R-exts said the progress bar
@@ -289,12 +289,13 @@ process_file = function(text, output) {
     on.exit(close(getOption("knitr.knit_progress")), add = TRUE)
   }
   wd = getwd()
+  on.exit(setwd(wd))
 
   for (i in seq_len(n)) {
     if (!is.null(.knitEnv$terminate)) {
       if (!child_mode() || !.knitEnv$terminate_fully) {
         # reset the internal variable `terminate` in the top parent
-        res[i] = one_string(.knitEnv$terminate)
+        res[[i]] = one_string(.knitEnv$terminate)
         knit_exit(NULL, NULL)
       }
       break  # must have called knit_exit(), so exit early
@@ -302,29 +303,36 @@ process_file = function(text, output) {
     if (progress && !child_mode()) {
       set_knit_progress(i)
     }
-    group = groups[[i]]
 
+    # first capture messages, then output them
     messages <- capture.output(
       {
-      res[i] = withCallingHandlers(
-        if (tangle) process_tangle(group) else process_group(group),
-        error = function(e) {
-          setwd(wd)
-          cat(res, sep = '\n', file = output %n% '')
-          message(
-            'Quitting from lines ', paste(current_lines(i), collapse = '-'),
-            ' (', knit_concord$get('infile'), ') '
-          )
-        }
-      )
+        res[[i]] = try(
+          expr = if (tangle) process_tangle(groups[[i]]) else process_group(groups[[i]]),
+          silent = TRUE
+        )
       }
       , type = "message"
     )
-    if(length(messages)) {
-      cat("\r", strrep(" ", getOption("width")))
-      cat("\r", messages, sep = "\n")
+
+    for (j in seq_along(messages)) {
+      message(if (!opts_knit$get("verbose")) "\r" else "\n", strrep(" ", getOption("width")), "\r", messages[[j]], appendLF = TRUE)
+    }
+
+    if(inherits(res[[i]], "try-error")) {
+      cat("\n")
+      stop(
+        "Quitting from lines ",
+        paste(current_lines(i), collapse = '-'),
+        " in ",
+        encodeString(knit_concord$get('infile'), quote = "'"),
+        ":\n",
+        attr(res[[i]], "condition")$message,
+        call. = FALSE
+      )
     }
   }
+  res <- unlist(res)
 
   if (!tangle) res = insert_header(res)  # insert header
   # output line numbers

From d08e06993bce12a38e22412b452fa953b6792318 Mon Sep 17 00:00:00 2001
From: mariusbarth <marius.barth@uni-koeln.de>
Date: Thu, 12 Aug 2021 23:41:54 +0200
Subject: [PATCH 10/17] make messages popping up from knitting more helpful

---
 R/output.R | 14 +++++++++++++-
 1 file changed, 13 insertions(+), 1 deletion(-)

diff --git a/R/output.R b/R/output.R
index d9a58fd7ba..96b31b80ac 100644
--- a/R/output.R
+++ b/R/output.R
@@ -315,8 +315,20 @@ process_file = function(text, output) {
       , type = "message"
     )
 
+    if(length(messages) > 0L) {
+      message(
+        if (!opts_knit$get("verbose")) "\r" else "\n", strrep(" ", getOption("width")),
+        "\rMessages from lines ",
+        paste(current_lines(i), collapse = '-'),
+        " in ",
+        encodeString(knit_concord$get('infile'), quote = "'"),
+        ":",
+        appendLF = TRUE
+      )
+    }
+
     for (j in seq_along(messages)) {
-      message(if (!opts_knit$get("verbose")) "\r" else "\n", strrep(" ", getOption("width")), "\r", messages[[j]], appendLF = TRUE)
+      message("  ", messages[[j]], appendLF = TRUE)
     }
 
     if(inherits(res[[i]], "try-error")) {

From 9063e44e4f1e5b16c129662a9f8fcdb078f83f40 Mon Sep 17 00:00:00 2001
From: mariusbarth <marius.barth@uni-koeln.de>
Date: Fri, 13 Aug 2021 00:04:22 +0200
Subject: [PATCH 11/17] trying to fix check errors

---
 R/output.R | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/R/output.R b/R/output.R
index 96b31b80ac..c613d29330 100644
--- a/R/output.R
+++ b/R/output.R
@@ -333,6 +333,8 @@ process_file = function(text, output) {
 
     if(inherits(res[[i]], "try-error")) {
       cat("\n")
+      setwd(wd)
+      cat(unlist(res[seq_len(i - 1L)]), sep = '\n', file = output %n% '')
       stop(
         "Quitting from lines ",
         paste(current_lines(i), collapse = '-'),

From f6bcd195ef0f70f11e9d8d569a2de6b28daadd82 Mon Sep 17 00:00:00 2001
From: mariusbarth <marius.barth@uni-koeln.de>
Date: Fri, 13 Aug 2021 00:52:42 +0200
Subject: [PATCH 12/17] trying to fix error in example 093

---
 R/output.R | 1 -
 1 file changed, 1 deletion(-)

diff --git a/R/output.R b/R/output.R
index c613d29330..10bb0feec3 100644
--- a/R/output.R
+++ b/R/output.R
@@ -289,7 +289,6 @@ process_file = function(text, output) {
     on.exit(close(getOption("knitr.knit_progress")), add = TRUE)
   }
   wd = getwd()
-  on.exit(setwd(wd))
 
   for (i in seq_len(n)) {
     if (!is.null(.knitEnv$terminate)) {

From 436fc84dda191378646623cafc7045408931fdbe Mon Sep 17 00:00:00 2001
From: mariusbarth <marius.barth@uni-koeln.de>
Date: Fri, 13 Aug 2021 14:03:56 +0200
Subject: [PATCH 13/17] yet another attempt at fixing the examples errors

- rolling back to `withCallingHandlers()`
---
 R/output.R | 79 ++++++++++++++++++++++++++++++++++++------------------
 1 file changed, 53 insertions(+), 26 deletions(-)

diff --git a/R/output.R b/R/output.R
index 10bb0feec3..434f951e00 100644
--- a/R/output.R
+++ b/R/output.R
@@ -278,7 +278,7 @@ purl = function(..., documentation = 1L) {
 process_file = function(text, output) {
   groups = split_file(lines = text)
   n <- length(groups)
-  res <- vector(mode = "list", length = n)
+  res <- character(n)
   tangle <- opts_knit$get('tangle')
 
   # when in R CMD check, turn off the progress bar (R-exts said the progress bar
@@ -303,17 +303,37 @@ process_file = function(text, output) {
       set_knit_progress(i)
     }
 
+    e.handler <- function(e) {
+      setwd(wd)
+      cat(res, sep = '\n', file = output %n% '')
+      message(
+        'Quitting from lines ', paste(current_lines(i), collapse = '-'),
+        ' (', knit_concord$get('infile'), ') '
+      )
+    }
+    message_env <- new.env()
+    message_env$messages <- character()
+    # message_env$warnings <- character()
+
+    # w.handler <- function(w){ # warning handler, courtesy of Martin Maechler
+    #   message_env$warnings <<- c(evalq(warnings, message_env), w$message)
+    #   invokeRestart("muffleWarning")
+    # }
+    m.handler <- function(m){ # warning handler, courtesy of Martin Maechler
+      message_env$messages <<- c(evalq(messages, message_env), m$message)
+      invokeRestart("muffleMessage")
+    }
+
     # first capture messages, then output them
-    messages <- capture.output(
-      {
-        res[[i]] = try(
-          expr = if (tangle) process_tangle(groups[[i]]) else process_group(groups[[i]]),
-          silent = TRUE
-        )
-      }
-      , type = "message"
+    res[i] = withCallingHandlers(
+      if (tangle) process_tangle(groups[[i]]) else process_group(groups[[i]]),
+      error   = e.handler,
+      # warning = w.handler,
+      message = m.handler
     )
 
+    messages <- message_env$messages
+
     if(length(messages) > 0L) {
       message(
         if (!opts_knit$get("verbose")) "\r" else "\n", strrep(" ", getOption("width")),
@@ -327,25 +347,9 @@ process_file = function(text, output) {
     }
 
     for (j in seq_along(messages)) {
-      message("  ", messages[[j]], appendLF = TRUE)
-    }
-
-    if(inherits(res[[i]], "try-error")) {
-      cat("\n")
-      setwd(wd)
-      cat(unlist(res[seq_len(i - 1L)]), sep = '\n', file = output %n% '')
-      stop(
-        "Quitting from lines ",
-        paste(current_lines(i), collapse = '-'),
-        " in ",
-        encodeString(knit_concord$get('infile'), quote = "'"),
-        ":\n",
-        attr(res[[i]], "condition")$message,
-        call. = FALSE
-      )
+      message("  ", messages[[j]], appendLF = FALSE)
     }
   }
-  res <- unlist(res)
 
   if (!tangle) res = insert_header(res)  # insert header
   # output line numbers
@@ -825,3 +829,26 @@ knit_meta_add = function(meta, label = '') {
   }
   .knitEnv$meta
 }
+
+# tryCatch.M.W.E <- function(expr) {
+#   w.handler <- function(w){ # warning handler
+#     cat(w$message, "\n")
+#     invokeRestart("muffleWarning")
+#   }
+#   m.handler <- function(m) {
+#     cat(m$message, "\n")
+#     invokeRestart("muffleMessage")
+#   }
+#   list(value = withCallingHandlers(
+#     tryCatch(expr, error = function(e) e),
+#       warning = w.handler,
+#       message = m.handler
+#     )
+#   )
+# }
+#
+# res <- tryCatch.M.W.E(expr = {
+#   warning("first warning")
+#   warning("second warning")
+#   message("first message")
+# })

From b61a5453dd69191cf6f398c641ed5fed8fbca560 Mon Sep 17 00:00:00 2001
From: mariusbarth <marius.barth@uni-koeln.de>
Date: Sun, 15 Aug 2021 00:44:19 +0200
Subject: [PATCH 14/17] cleanup

---
 R/output.R | 40 ++++++++++++++++++----------------------
 1 file changed, 18 insertions(+), 22 deletions(-)

diff --git a/R/output.R b/R/output.R
index 434f951e00..8b05146749 100644
--- a/R/output.R
+++ b/R/output.R
@@ -333,6 +333,7 @@ process_file = function(text, output) {
     )
 
     messages <- message_env$messages
+    # warnings <- message_env$warnings
 
     if(length(messages) > 0L) {
       message(
@@ -349,6 +350,23 @@ process_file = function(text, output) {
     for (j in seq_along(messages)) {
       message("  ", messages[[j]], appendLF = FALSE)
     }
+
+    # if(length(warnings) > 0L) {
+    #   warning(
+    #     if (!opts_knit$get("verbose")) "\r" else "\n", strrep(" ", getOption("width")),
+    #     "\rWarnings from lines ",
+    #     paste(current_lines(i), collapse = '-'),
+    #     " in ",
+    #     encodeString(knit_concord$get('infile'), quote = "'"),
+    #     ":",
+    #     immediate. = TRUE,
+    #     call. = FALSE
+    #   )
+    # }
+
+    # for (j in seq_along(warnings)) {
+    #   message("  ", warnings[[j]])
+    # }
   }
 
   if (!tangle) res = insert_header(res)  # insert header
@@ -830,25 +848,3 @@ knit_meta_add = function(meta, label = '') {
   .knitEnv$meta
 }
 
-# tryCatch.M.W.E <- function(expr) {
-#   w.handler <- function(w){ # warning handler
-#     cat(w$message, "\n")
-#     invokeRestart("muffleWarning")
-#   }
-#   m.handler <- function(m) {
-#     cat(m$message, "\n")
-#     invokeRestart("muffleMessage")
-#   }
-#   list(value = withCallingHandlers(
-#     tryCatch(expr, error = function(e) e),
-#       warning = w.handler,
-#       message = m.handler
-#     )
-#   )
-# }
-#
-# res <- tryCatch.M.W.E(expr = {
-#   warning("first warning")
-#   warning("second warning")
-#   message("first message")
-# })

From 0ba01fbda637c65bbeac4994d4de43529c8c2b79 Mon Sep 17 00:00:00 2001
From: mariusbarth <marius.barth@uni-koeln.de>
Date: Sun, 15 Aug 2021 00:49:30 +0200
Subject: [PATCH 15/17] removed extraneous indentation

---
 R/knit_progress.R | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/R/knit_progress.R b/R/knit_progress.R
index 9494fe8f92..61521b908b 100644
--- a/R/knit_progress.R
+++ b/R/knit_progress.R
@@ -20,7 +20,7 @@ knit_progress <- function (
   text_width <- getOption("width") - width - 8
 
 
-  up <- function(value, text, carriage_return = "\r ") {
+  up <- function(value, text, carriage_return = "\r") {
 
     nb <- round(width * value/max)
     pc <- round(100 * value/max)
@@ -28,7 +28,7 @@ knit_progress <- function (
     if (nb == .nb && pc == .pc && text == .text) return()
     if (!is.finite(value) || value > max) stop("knitr::knit_progress() 'value' is ", value)
 
-    if(isTRUE(knitr::opts_knit$get("verbose")) && text != .text) carriage_return <- "\n "
+    if(isTRUE(knitr::opts_knit$get("verbose")) && text != .text) carriage_return <- "\n"
 
     .text <<- text
     .val <<- value

From 6eff14e38e8f2589b62c0b0fc1c039060dbf1880 Mon Sep 17 00:00:00 2001
From: mariusbarth <marius.barth@uni-koeln.de>
Date: Mon, 23 Aug 2021 13:52:50 +0200
Subject: [PATCH 16/17] never add leading whitespace to progress-bar text

---
 R/knit_progress.R | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/R/knit_progress.R b/R/knit_progress.R
index 61521b908b..e6e8dbff13 100644
--- a/R/knit_progress.R
+++ b/R/knit_progress.R
@@ -55,7 +55,7 @@ knit_progress <- function (
     .killed <<- TRUE
   }
 
-  up(value = 0, text = "Knitting...", carriage_return = "\n ")
+  up(value = 0, text = "Knitting...", carriage_return = "\n")
   structure(list(getVal = getVal, getText = getText, up = up, kill = kill), class = "txtProgressBar")
 }
 

From 98912f670b72b65e7b92183b574f2ab733077938 Mon Sep 17 00:00:00 2001
From: mariusbarth <marius.barth@uni-koeln.de>
Date: Mon, 13 Sep 2021 17:18:00 +0200
Subject: [PATCH 17/17] removed stringr dependency in new progress bar

---
 R/knit_progress.R | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/R/knit_progress.R b/R/knit_progress.R
index e6e8dbff13..10190d7f44 100644
--- a/R/knit_progress.R
+++ b/R/knit_progress.R
@@ -36,7 +36,7 @@ knit_progress <- function (
 
     cat(
       carriage_return
-      , stringr::str_trunc(encodeString(text, width = text_width), width = text_width)
+      , strtrim(encodeString(text, width = text_width), width = text_width)
       , "|"
       , rep.int(char, nb)
       , rep.int(" ", width - nb)