Make code_highlight() handle tabs ('\t') correctly.

This moves the existing function substr_with_tabs() at file level, so
it can be called by replace_in_place().

Author: mcol

NEWS.md

@@ -3,6 +3,8 @@
 * New `{.num}` and `{.bytes}` inline styles to format numbers
   and bytes (@m-muecke, #644, #588, #643).
 
+* `code_highlight()` handles tab characters (`\t`) correctly (@mcol, #783).
+
 # cli 3.6.5
 
 * `code_highlight()` supports long strings and symbols

R/prettycode.R

@@ -159,33 +159,33 @@ code_highlight <- function(code, code_theme = NULL, envir = NULL) {
   do_subst(code, data, hitext)
 }
 
+substr_with_tabs <- function(x, start, stop, tabsize = 8) {
+  widths <- rep_len(1, nchar(x))
+  tabs <- which(strsplit(x, "")[[1]] == "\t")
+  for (i in tabs) {
+    cols <- cumsum(widths)
+    widths[i] <- tabsize - (cols[i] - 1) %% tabsize
+  }
+  cols <- cumsum(widths)
+  start <- which(cols >= start)
+  if (!length(start)) {
+    return("")
+  }
+  start <- start[1]
+  stop <- which(cols <= stop)
+  if (length(stop)) {
+    stop <- stop[length(stop)]
+    substr(x, start, stop)
+  } else {
+    ""
+  }
+}
+
 get_parse_data <- function(x) {
   # getParseData(x, includeText = NA) would trim long strings and symbols
   data <- getParseData(x, includeText = FALSE)
   data$text <- character(nrow(data))
 
-  substr_with_tabs <- function(x, start, stop, tabsize = 8) {
-    widths <- rep_len(1, nchar(x))
-    tabs <- which(strsplit(x, "")[[1]] == "\t")
-    for (i in tabs) {
-      cols <- cumsum(widths)
-      widths[i] <- tabsize - (cols[i] - 1) %% tabsize
-    }
-    cols <- cumsum(widths)
-    start <- which(cols >= start)
-    if (!length(start)) {
-      return("")
-    }
-    start <- start[1]
-    stop <- which(cols <= stop)
-    if (length(stop)) {
-      stop <- stop[length(stop)]
-      substr(x, start, stop)
-    } else {
-      ""
-    }
-  }
-
   srcfile <- attr(data, "srcfile")
   terminal <- which(data$terminal)
   for (i in terminal) {
@@ -294,7 +294,10 @@ replace_in_place <- function(str, start, end, replacement) {
     length(end) == length(replacement)
   )
 
-  keep <- substring(str, c(1, end + 1), c(start - 1, nchar(str)))
+  starts <- c(1, end + 1)
+  ends <- c(start - 1, nchar(str))
+  keep <- sapply(seq_along(starts),
+                 function(i) substr_with_tabs(str, starts[i], ends[i]))
 
   pieces <- character(length(replacement) * 2 + 1)
 

tests/testthat/_snaps/prettycode.md

@@ -223,3 +223,17 @@
     Output
       \(x) x * 2
 
+# strings with tabs [plain]
+
+    Code
+      code_highlight("x\t + 1")
+    Output
+      [1] "x\t + 1"
+
+# strings with tabs [ansi]
+
+    Code
+      code_highlight("x\t + 1")
+    Output
+      [1] "x\t \033[33m+\033[39m \033[35m1\033[39m"
+

tests/testthat/test-prettycode.R

@@ -145,6 +145,11 @@ test_that("replace_in_place", {
     replace_in_place("1234567890", c(1, 5), c(6, 10), c("A", "B")),
     "AB"
   )
+
+  expect_equal(
+    replace_in_place("x\t + 1", c(1, 10, 12), c(1, 10, 12), c("x", "+", "1")),
+    "x\t + 1"
+  )
 })
 
 test_that("replace_in_place corner cases", {
@@ -264,6 +269,11 @@ test_that_cli(configs = "ansi", "new language features, lambda functions", {
   )
 })
 
+test_that_cli(configs = c("plain", "ansi"), "strings with tabs", {
+  expect_snapshot(
+      code_highlight("x\t + 1"))
+})
+
 test_that("code_highlight() works on long strings and symbols", {
   expect_true(
     grepl(