diff --git a/NEWS.md b/NEWS.md index 5561d0b4..b0b74c72 100644 --- a/NEWS.md +++ b/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. diff --git a/R/prettycode.R b/R/prettycode.R index 7c695efb..9c07ab59 100644 --- a/R/prettycode.R +++ b/R/prettycode.R @@ -55,7 +55,7 @@ code_highlight <- function(code, code_theme = NULL, envir = NULL) { } theme <- code_theme_make(code_theme) - data <- getParseData(parsed, includeText = NA) + data <- get_parse_data(parsed) hitext <- data$text @@ -125,6 +125,47 @@ code_highlight <- function(code, code_theme = NULL, envir = NULL) { 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 diff --git a/tests/testthat/test-prettycode.R b/tests/testthat/test-prettycode.R index ed28256d..4715e69a 100644 --- a/tests/testthat/test-prettycode.R +++ b/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")) + ) + ) +})