Fix how kable_mark() measures column width when there are hyperlinks

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: knitr
 Type: Package
 Title: A General-Purpose Package for Dynamic Report Generation in R
-Version: 1.39.5
+Version: 1.39.6
 Authors@R: c(
     person("Yihui", "Xie", role = c("aut", "cre"), email = "xie@yihui.name", comment = c(ORCID = "0000-0003-0645-5666")),
     person("Abhraneel", "Sarma", role = "ctb"),
@@ -41,6 +41,7 @@ Authors@R: c(
     person("Hiroaki", "Yutani", role = "ctb"),
     person("Ian", "Lyttle", role = "ctb"),
     person("Hodges", "Daniel", role = "ctb"),
+    person("Jacob", "Bien", role = "ctb"),
     person("Jake", "Burkhead", role = "ctb"),
     person("James", "Manton", role = "ctb"),
     person("Jared", "Lander", role = "ctb"),

NEWS.md

@@ -10,6 +10,8 @@
 
 - Fixed `epub2` output not being considered as HTML format (thanks, @flipacholas, #2145).
 
+- `kable(format = 'pipe')` calculates column widths correctly now if any text columns contain Markdown hyperlinks (thanks, @jacobbien, #2148).
+
 ## MINOR CHANGES
 
 - When the inline R code cannot be correctly parsed, the error message will show the original code in addition to the parsing error, which can make it easier to identify the code error in the source document (thanks, @AlbertLei, #2141).

R/table.R

@@ -391,13 +391,13 @@ kable_mark = function(x, sep.row = c('=', '=', '='), sep.col = '  ', padding = 0
   if (sep.col == '|') for (j in seq_len(ncol(x))) {
     x[, j] = gsub('\\|', '|', x[, j])
   }
-  l = if (prod(dim(x)) > 0) apply(x, 2, function(z) max(nchar(z, type = 'width'), na.rm = TRUE))
+  l = if (prod(dim(x)) > 0) apply(x, 2, function(z) max(nchar(remove_urls(z), type = 'width'), na.rm = TRUE))
   cn = colnames(x)
   if (length(cn) > 0) {
     cn[is.na(cn)] = "NA"
     if (sep.col == '|') cn = gsub('\\|', '|', cn)
     if (grepl('^\\s*$', cn[1L])) cn[1L] = rownames.name  # no empty cells for reST
-    l = pmax(if (length(l) == 0) 0 else l, nchar(cn, type = 'width'))
+    l = pmax(if (length(l) == 0) 0 else l, nchar(remove_urls(cn), type = 'width'))
   }
   align = attr(x, 'align')
   padding = padding * if (length(align) == 0) 2 else {

R/utils.R

@@ -1059,3 +1059,9 @@ make_unique = function(x) {
 #' browseURL('logo.html') # you can check its HTML source
 #' }
 image_uri = function(f) xfun::base64_uri(f)
+
+# Change all "[label](url)" to "label" except leave "`[label](url)`" as is
+remove_urls = function(x) {
+  # regex adapted from https://dev.to/mattkenefick/regex-convert-markdown-links-to-html-anchors-f7j
+  gsub("(?<!`)\\[([^]]+)\\]\\(([^)]+)\\)(?!`)", "\\1", x, perl = TRUE)
+}

tests/testit/test-utils.R

@@ -233,3 +233,10 @@ assert('comment_out() add prefix and newlines if asked', {
   (comment_out("a", prefix = "$") %==% "$ a\n")
   (comment_out("a", prefix = NULL) %==% "a\n")
 })
+
+assert('remove_urls() removes the link', {
+  (remove_urls(c('[a](b)', '[a b](c)')) %==% c('a', 'a b'))
+  (remove_urls('a [b](c) d.') %==% 'a b d.')
+  (remove_urls('a [b](c) d [e f+g](h) i.') %==% 'a b d e f+g i.')
+  (remove_urls('a [b](c) `[d](e)` f.') %==% 'a b `[d](e)` f.')
+})