Skip to content

Commit

Permalink
Merge pull request #739 from r-lib/positron-arms-length-task
Browse files Browse the repository at this point in the history
  • Loading branch information
@gaborcsardi
gaborcsardi authored Nov 9, 2024
2 parents 7ca06ff + 8ef3a37 commit 169949c
Show file tree
Hide file tree
Showing 8 changed files with 283 additions and 76 deletions.
134 changes: 76 additions & 58 deletions R/ansi-hyperlink.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
}

Expand All @@ -151,21 +149,16 @@ make_link_fun <- function(txt) {
make_link_help <- function(txt) {
mch <- re_match(txt, "^\\[(?<text>.*)\\]\\((?<url>.*)\\)$")
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} --------------------------------------------------------------
Expand Down Expand Up @@ -193,42 +186,32 @@ make_link_href <- function(txt) {
make_link_run <- function(txt) {
mch <- re_match(txt, "^\\[(?<text>.*)\\]\\((?<url>.*)\\)$")
text <- ifelse(is.na(mch$text), txt, mch$text)
url <- ifelse(is.na(mch$url), txt, mch$url)
code <- ifelse(is.na(mch$url), txt, mch$url)

sprt <- ansi_hyperlink_types()$run
if (sprt) {
scheme <- if (identical(attr(sprt, "type"), "rstudio")) {
"ide:run"
} else {
"x-r-run"
}
style_hyperlink(text = text, url = paste0(scheme, ":", url))

} else {
vcapply(text, function(url1) format_inline("{.code {url1}}"))
if (!sprt) {
return(vcapply(text, function(code1) format_inline("{.code {code1}}")))
}

fmt <- get_hyperlink_format("run")
style_hyperlink(text = text, url = glue(fmt))
}

# -- {.topic} -------------------------------------------------------------

make_link_topic <- function(txt) {
mch <- re_match(txt, "^\\[(?<text>.*)\\]\\((?<url>.*)\\)$")
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} ---------------------------------------------------------------
Expand All @@ -245,21 +228,16 @@ make_link_url <- function(txt) {
make_link_vignette <- function(txt) {
mch <- re_match(txt, "^\\[(?<text>.*)\\]\\((?<url>.*)\\)$")
text <- ifelse(is.na(mch$text), txt, mch$text)
url <- ifelse(is.na(mch$url), txt, mch$url)
vignette <- ifelse(is.na(mch$url), txt, mch$url)

sprt <- ansi_hyperlink_types()$vignette
if (sprt) {
scheme <- if (identical(attr(sprt, "type"), "rstudio")) {
"ide:vignette"
} else {
"x-r-vignette"
}
style_hyperlink(text = text, url = paste0(scheme, ":", url))

} else {
url2 <- vcapply(url, function(url1) format_inline("{.code vignette({url1})}"))
ifelse(text == url, url2, paste0(text, " (", url2, ")"))
if (!sprt) {
vignette2 <- vcapply(vignette, function(x) format_inline("{.code vignette({x})}"))
return(ifelse(text == vignette, vignette2, paste0(text, " (", vignette2, ")")))
}

fmt <- get_hyperlink_format("vignette")
style_hyperlink(text = text, url = glue(fmt))
}

#' Terminal Hyperlinks
Expand Down Expand Up @@ -426,3 +404,43 @@ 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)) {
stopifnot(is_string(opt))
return(opt)
}

env <- Sys.getenv(paste0("R_CLI_", toupper(x)), NA_character_)
if (!is.na(env)) return(env)

default
}
17 changes: 17 additions & 0 deletions R/test.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -112,6 +112,14 @@ 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_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)))
Expand All @@ -131,13 +139,22 @@ 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
)
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_,
Expand Down
35 changes: 35 additions & 0 deletions tests/testthat/_snaps/links.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -819,6 +819,13 @@
Message
`pkg::func()`

# .fun with custom format [plain-all]

Code
cli_text("{.fun pkg::func}")
Message
`]8;;aaa-pkg::func-zzzpkg::func]8;;()`

# {.help} [plain-none]

Code
Expand Down Expand Up @@ -857,6 +864,13 @@
Message
]8;;x-r-help:pkg::fun1pkg::fun1]8;;, ]8;;x-r-help:pkg::fun2pkg::fun2]8;;, and ]8;;x-r-help:pkg::fun3pkg::fun3]8;;

# .help with custom format [plain-all]

Code
cli_text("{.help pkg::fun}")
Message
]8;;aaa-pkg::fun-zzzpkg::fun]8;;

# {.href} [plain-none]

Code
Expand Down Expand Up @@ -943,6 +957,13 @@
Message
]8;;x-r-run:pkg::fun1()pkg::fun1()]8;;, ]8;;x-r-run:pkg::fun2()pkg::fun2()]8;;, and ]8;;x-r-run:pkg::fun3()pkg::fun3()]8;;

# .run with custom format [plain-all]

Code
cli_text("{.run devtools::document()}")
Message
]8;;aaa-devtools::document()-zzzdevtools::document()]8;;

# {.topic} [plain-none]

Code
Expand Down Expand Up @@ -981,6 +1002,13 @@
Message
]8;;x-r-help:pkg::topic1pkg::topic1]8;;, ]8;;x-r-help:pkg::topic2pkg::topic2]8;;, and ]8;;x-r-help:pkg::topic3pkg::topic3]8;;

# .topic with custom format [plain-all]

Code
cli_text("{.topic pkg::fun}")
Message
]8;;aaa-pkg::fun-zzzpkg::fun]8;;

# {.url} [plain-none]

Code
Expand Down Expand Up @@ -1092,3 +1120,10 @@
Message
]8;;x-r-vignette:pkg::topic1pkg::topic1]8;;, ]8;;x-r-vignette:pkg::topic2pkg::topic2]8;;, and ]8;;x-r-vignette:pkg::topic3pkg::topic3]8;;

# .vignette with custom format [plain-all]

Code
cli_text("{.vignette pkgdown::accessibility}")
Message
]8;;aaa-pkgdown::accessibility-zzzpkgdown::accessibility]8;;

52 changes: 52 additions & 0 deletions tests/testthat/test-ansi-hyperlink.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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(),
Expand Down Expand Up @@ -370,3 +371,54 @@ test_that("ansi_hyperlink_types", {
)
expect_true(ansi_hyperlink_types()[["run"]])
})

test_that("get_config_chr() consults option, env var, then its default", {
local_clean_cli_context()

key <- "hyperlink_TYPE_url_format"

expect_null(get_config_chr(key))

withr::local_envvar(R_CLI_HYPERLINK_TYPE_URL_FORMAT = "envvar")
expect_equal(get_config_chr(key), "envvar")

withr::local_options(cli.hyperlink_type_url_format = "option")
expect_equal(get_config_chr(key), "option")
})

test_that("get_config_chr() errors if option is not NULL or string", {
withr::local_options(cli.something = FALSE)

expect_error(get_config_chr("something"), "is_string")
})

test_that("get_hyperlink_format() delivers custom format", {
local_clean_cli_context()

withr::local_options(
cli.hyperlink_run = TRUE,
cli.hyperlink_help = TRUE,
cli.hyperlink_vignette = TRUE
)

# env var is consulted after option, so start with env var
withr::local_envvar(
R_CLI_HYPERLINK_RUN_URL_FORMAT = "envvar{code}",
R_CLI_HYPERLINK_HELP_URL_FORMAT = "envvar{topic}",
R_CLI_HYPERLINK_VIGNETTE_URL_FORMAT = "envvar{vignette}"
)

expect_equal(get_hyperlink_format("run"), "envvar{code}")
expect_equal(get_hyperlink_format("help"), "envvar{topic}")
expect_equal(get_hyperlink_format("vignette"), "envvar{vignette}")

withr::local_options(
cli.hyperlink_run_url_format = "option{code}",
cli.hyperlink_help_url_format = "option{topic}",
cli.hyperlink_vignette_url_format = "option{vignette}"
)

expect_equal(get_hyperlink_format("run"), "option{code}")
expect_equal(get_hyperlink_format("help"), "option{topic}")
expect_equal(get_hyperlink_format("vignette"), "option{vignette}")
})
Loading

0 comments on commit 169949c

Please sign in to comment.