From 85578b1705a2faa616f46ee2949f4d4e6e1be3af Mon Sep 17 00:00:00 2001 From: Jenny Bryan Date: Thu, 31 Oct 2024 19:24:56 -0700 Subject: [PATCH] Handle all the x-r-whatever links --- R/ansi-hyperlink.R | 85 ++++++++++++++++------------ R/test.R | 21 +++++++ tests/testthat/test-ansi-hyperlink.R | 2 + 3 files changed, 73 insertions(+), 35 deletions(-) diff --git a/R/ansi-hyperlink.R b/R/ansi-hyperlink.R index 078b7daa8..336e56cce 100644 --- a/R/ansi-hyperlink.R +++ b/R/ansi-hyperlink.R @@ -130,19 +130,17 @@ make_link_fun <- function(txt) { if (!any(todo)) return(txt) sprt <- ansi_hyperlink_types()$help - if (sprt) { - scheme <- if (identical(attr(sprt, "type"), "rstudio")) { - "ide:help" - } else { - "x-r-help" - } - - txt[todo] <- style_hyperlink( - text = txt[todo], - url = paste0(scheme, ":", txt[todo]) - ) + if (!sprt) { + return(txt) } + fmt <- get_hyperlink_format("help") + # the format has a placeholder for 'topic' + topic <- txt[todo] + done <- style_hyperlink(text = topic, url = glue(fmt)) + + txt[todo] <- done + txt } @@ -151,21 +149,16 @@ make_link_fun <- function(txt) { make_link_help <- function(txt) { mch <- re_match(txt, "^\\[(?.*)\\]\\((?.*)\\)$") text <- ifelse(is.na(mch$text), txt, mch$text) - url <- ifelse(is.na(mch$url), txt, mch$url) + topic <- ifelse(is.na(mch$url), txt, mch$url) sprt <- ansi_hyperlink_types()$help - if (sprt) { - scheme <- if (identical(attr(sprt, "type"), "rstudio")) { - "ide:help" - } else { - "x-r-help" - } - style_hyperlink(text = text, url = paste0(scheme, ":", url)) - - } else { - url2 <- vcapply(url, function(url1) format_inline("{.fun ?{url1}}")) - ifelse(text == url, url2, paste0(text, " (", url2, ")")) + if (!sprt) { + topic2 <- vcapply(topic, function(x) format_inline("{.fun ?{x}}")) + return(ifelse(text == topic, topic2, paste0(text, " (", topic2, ")"))) } + + fmt <- get_hyperlink_format("help") + style_hyperlink(text = text, url = glue(fmt)) } # -- {.href} -------------------------------------------------------------- @@ -225,21 +218,16 @@ make_link_run <- function(txt) { make_link_topic <- function(txt) { mch <- re_match(txt, "^\\[(?.*)\\]\\((?.*)\\)$") text <- ifelse(is.na(mch$text), txt, mch$text) - url <- ifelse(is.na(mch$url), txt, mch$url) + topic <- ifelse(is.na(mch$url), txt, mch$url) sprt <- ansi_hyperlink_types()$help - if (sprt) { - scheme <- if (identical(attr(sprt, "type"), "rstudio")) { - "ide:help" - } else { - "x-r-help" - } - style_hyperlink(text = text, url = paste0(scheme, ":", url)) - - } else { - url2 <- vcapply(url, function(url1) format_inline("{.code ?{url1}}")) - ifelse(text == url, url2, paste0(text, " (", url2, ")")) + if (!sprt) { + topic2 <- vcapply(topic, function(x) format_inline("{.code ?{x}}")) + return(ifelse(text == topic, topic2, paste0(text, " (", topic2, ")"))) } + + fmt <- get_hyperlink_format("help") + style_hyperlink(text = text, url = glue(fmt)) } # -- {.url} --------------------------------------------------------------- @@ -438,6 +426,33 @@ ansi_hyperlink_types <- function() { } } +get_hyperlink_format <- function(type = c("run", "help", "vignette")) { + type <- match.arg(type) + + key <- glue("hyperlink_{type}_url_format") + sprt <- ansi_hyperlink_types()[[type]] + + custom_fmt <- get_config_chr(key) + if (is.null(custom_fmt)) { + if (identical(attr(sprt, "type"), "rstudio")) { + fmt_type <- "rstudio" + } else { + fmt_type <- "standard" + } + } else { + fmt_type <- "custom" + } + + variable <- c(run = "code", help = "topic", vignette = "vignette") + fmt <- switch( + fmt_type, + custom = custom_fmt, + rstudio = glue("ide:{type}:{{{variable[type]}}}"), + standard = glue("x-r-{type}:{{{variable[type]}}}") + ) + fmt +} + get_config_chr <- function(x, default = NULL) { opt <- getOption(paste0("cli.", tolower(x))) if (!is.null(opt)) { diff --git a/R/test.R b/R/test.R index 3d7c3167d..b6c962776 100644 --- a/R/test.R +++ b/R/test.R @@ -112,6 +112,18 @@ test_that_cli <- function(desc, code, cli.hyperlink_help = links, cli.hyperlink_run = links, cli.hyperlink_vignette = links, + cli.hyperlink_run_url_format = NULL, + cli.hyperlink_help_url_format = NULL, + cli.hyperlink_vignette_url_format = NULL, + ) + withr::local_envvar( + R_CLI_HYPERLINKS = NA_character_, + R_CLI_HYPERLINK_RUN = NA_character_, + R_CLI_HYPERLINK_HELP = NA_character_, + R_CLI_HYPERLINK_VIGNETTE = NA_character_, + R_CLI_HYPERLINK_RUN_URL_FORMAT = NA_character_, + R_CLI_HYPERLINK_HELP_URL_FORMAT = NA_character_, + R_CLI_HYPERLINK_VIGNETTE_URL_FORMAT = NA_character_, ) code_ }, c(conf, list(code_ = code))) @@ -131,6 +143,9 @@ local_clean_cli_context <- function(.local_envir = parent.frame()) { cli.hyperlink_run = NULL, cli.hyperlink_help = NULL, cli.hyperlink_vignette = NULL, + cli.hyperlink_run_url_format = NULL, + cli.hyperlink_help_url_format = NULL, + cli.hyperlink_vignette_url_format = NULL, cli.num_colors = NULL, cli.palette = NULL, crayon.enabled = NULL @@ -138,6 +153,12 @@ local_clean_cli_context <- function(.local_envir = parent.frame()) { withr::local_envvar( .local_envir = .local_envir, R_CLI_HYPERLINKS = NA_character_, + R_CLI_HYPERLINK_RUN = NA_character_, + R_CLI_HYPERLINK_HELP = NA_character_, + R_CLI_HYPERLINK_VIGNETTE = NA_character_, + R_CLI_HYPERLINK_RUN_URL_FORMAT = NA_character_, + R_CLI_HYPERLINK_HELP_URL_FORMAT = NA_character_, + R_CLI_HYPERLINK_VIGNETTE_URL_FORMAT = NA_character_, RSTUDIO_CLI_HYPERLINKS = NA_character_, R_CLI_NUM_COLORS = NA_character_, NO_COLOR = NA_character_, diff --git a/tests/testthat/test-ansi-hyperlink.R b/tests/testthat/test-ansi-hyperlink.R index 8b4de70f3..b22e809c2 100644 --- a/tests/testthat/test-ansi-hyperlink.R +++ b/tests/testthat/test-ansi-hyperlink.R @@ -240,6 +240,7 @@ test_that("iterm file links", { }) test_that("rstudio links", { + local_clean_cli_context() withr::local_envvar( RSTUDIO = "1", RSTUDIO_SESSION_PID = Sys.getpid(), @@ -252,6 +253,7 @@ test_that("rstudio links", { cli.hyperlink_run = TRUE, cli.hyperlink_vignette = TRUE ) + expect_snapshot( cli::cli_text("{.fun pkg::fun}") )