code_highlight() supports long strings and symbols

NEWS.md

@@ -12,6 +12,8 @@
 * `ansi_collapse()` is now correct for length-1 vectors with style "head"
   if width is specified (@rundel, #590).
 
+* `code_highlight()` supports long strings and symbols (#727 @moodymudskipper)
+
 # cli 3.6.3
 
 * cli now builds on ARM Windows.

R/prettycode.R

@@ -55,7 +55,7 @@
   }
 
   theme <- code_theme_make(code_theme)
-  data <- getParseData(parsed, includeText = NA)
+  data <- get_parse_data(parsed)
 
   hitext <- data$text
 
@@ -125,6 +125,47 @@
   do_subst(code, data, hitext)
 }
 
+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))
+
+  # inlining utils:::substr_with_tabs() used in utils::getParseText()
+  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 ""
+  }
+
+  # adapted from utils::getParseText()
+  srcfile <- attr(data, "srcfile")
+  terminal <- which(data$terminal)
+  for (i in terminal) {
+    lines <- getSrcLines(srcfile, data$line1[i], data$line2[i])
+    n <- length(lines)
+    lines[n] <- substr_with_tabs(lines[n], 1, data$col2[i])
+    lines[1] <- substr_with_tabs(lines[1], data$col1[i], Inf)
+    data$text[i] <- paste(lines, collapse = "\n")
+  }
+
+  data
+}
+
 do_subst <- function(code, pdata, hitext) {
 
   pdata$hitext <- hitext

tests/testthat/test-prettycode.R

@@ -245,3 +245,32 @@ test_that_cli(configs = "ansi", "new language features, lambda functions", {
     cat(code_highlight('\\(x) x * 2', list(reserved = "bold")))
   )
 })
+
+test_that("code_highlight() works on long strings and symbols", {
+  expect_true(
+    grepl(
+      strrep("-", 1000),
+      code_highlight(paste0("foo('", strrep("-", 1000), "')"))
+    )
+  )
+
+  expect_true(
+    grepl(
+      strrep("-", 1000),
+      code_highlight(paste0("foo(`", strrep("-", 1000), "`)"))
+    )
+  )
+  expect_true(
+    grepl(
+      strrep("-", 1000),
+      code_highlight(paste0("a$`", strrep("-", 1000), "`"))
+    )
+  )
+
+  expect_true(
+    grepl(
+      strrep("-", 1000),
+      code_highlight(paste0("`", strrep("-", 1000), "`$a"))
+    )
+  )
+})